aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/lux/analyser.clj28
-rw-r--r--src/lux/analyser/base.clj281
-rw-r--r--src/lux/analyser/case.clj156
-rw-r--r--src/lux/analyser/env.clj10
-rw-r--r--src/lux/analyser/host.clj218
-rw-r--r--src/lux/analyser/lambda.clj6
-rw-r--r--src/lux/analyser/lux.clj100
-rw-r--r--src/lux/analyser/meta.clj6
-rw-r--r--src/lux/analyser/module.clj8
-rw-r--r--src/lux/analyser/parser.clj40
-rw-r--r--src/lux/analyser/record.clj4
-rw-r--r--src/lux/base.clj396
-rw-r--r--src/lux/compiler/cache.clj8
-rw-r--r--src/lux/compiler/case.clj49
-rw-r--r--src/lux/compiler/host.clj28
-rw-r--r--src/lux/compiler/lux.clj2
-rw-r--r--src/lux/compiler/type.clj57
-rw-r--r--src/lux/host.clj6
-rw-r--r--src/lux/lexer.clj52
-rw-r--r--src/lux/optimizer.clj506
-rw-r--r--src/lux/parser.clj26
-rw-r--r--src/lux/reader.clj50
-rw-r--r--src/lux/type.clj326
-rw-r--r--src/lux/type/host.clj54
24 files changed, 1215 insertions, 1202 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index ae4d81a39..4d68ab0d5 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -26,19 +26,19 @@
:let [is-last? (= idx (dec (&/|length group)))]]
(if (= 1 (&/|length group))
(|do [_cursor &/cursor]
- (analyse exo-type (&/T [_cursor (&/V &/$TupleS values)])))
+ (analyse exo-type (&/T [_cursor (&/$TupleS values)])))
(|case exo-type
(&/$VarT id)
(|do [? (&type/bound? id)]
(if (or ? (&&/type-tag? module tag-name))
- (&&lux/analyse-variant analyse (&/V &/$Right exo-type) idx is-last? values)
+ (&&lux/analyse-variant analyse (&/$Right exo-type) idx is-last? values)
(|do [wanted-type (&&module/tag-type module tag-name)
- [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (&&lux/analyse-variant analyse (&/V &/$Left wanted-type) idx is-last? values))
+ [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (&&lux/analyse-variant analyse (&/$Left wanted-type) idx is-last? values))
_ (&type/check exo-type variant-type)]
(return (&/|list (&&/|meta exo-type variant-cursor variant-analysis))))))
_
- (&&lux/analyse-variant analyse (&/V &/$Right exo-type) idx is-last? values)
+ (&&lux/analyse-variant analyse (&/$Right exo-type) idx is-last? values)
))
))
@@ -398,7 +398,7 @@
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_try")]
(&/$Cons ?body
?handlers)))
- (|do [catches+finally (&/fold% &&a-parser/parse-handler (&/T [&/Nil$ &/None$]) ?handlers)]
+ (|do [catches+finally (&/fold% &&a-parser/parse-handler (&/T [&/$Nil &/$None]) ?handlers)]
(&&host/analyse-jvm-try analyse exo-type ?body catches+finally))
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_throw")]
@@ -594,36 +594,36 @@
(&/$BoolS ?value)
(|do [_ (&type/check exo-type &type/Bool)
_cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor (&/V &&/$bool ?value)))))
+ (return (&/|list (&&/|meta exo-type _cursor (&&/$bool ?value)))))
(&/$IntS ?value)
(|do [_ (&type/check exo-type &type/Int)
_cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor (&/V &&/$int ?value)))))
+ (return (&/|list (&&/|meta exo-type _cursor (&&/$int ?value)))))
(&/$RealS ?value)
(|do [_ (&type/check exo-type &type/Real)
_cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor (&/V &&/$real ?value)))))
+ (return (&/|list (&&/|meta exo-type _cursor (&&/$real ?value)))))
(&/$CharS ?value)
(|do [_ (&type/check exo-type &type/Char)
_cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor (&/V &&/$char ?value)))))
+ (return (&/|list (&&/|meta exo-type _cursor (&&/$char ?value)))))
(&/$TextS ?value)
(|do [_ (&type/check exo-type &type/Text)
_cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor (&/V &&/$text ?value)))))
+ (return (&/|list (&&/|meta exo-type _cursor (&&/$text ?value)))))
(&/$TupleS ?elems)
- (&&lux/analyse-tuple analyse (&/V &/$Right exo-type) ?elems)
+ (&&lux/analyse-tuple analyse (&/$Right exo-type) ?elems)
(&/$RecordS ?elems)
(&&lux/analyse-record analyse exo-type ?elems)
(&/$TagS ?ident)
- (analyse-variant+ analyse exo-type ?ident &/Nil$)
+ (analyse-variant+ analyse exo-type ?ident &/$Nil)
(&/$SymbolS ?ident)
(&&lux/analyse-symbol analyse exo-type ?ident)
@@ -669,7 +669,7 @@
(&/with-expected-type exo-type
(|case token
[meta (&/$FormS (&/$Cons [_ (&/$IntS idx)] ?values))]
- (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) (&/V &/$Right exo-type) idx nil ?values)
+ (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) (&/$Right exo-type) idx nil ?values)
[meta (&/$FormS (&/$Cons [_ (&/$TagS ?ident)] ?values))]
(analyse-variant+ (partial analyse-ast eval! compile-module compile-token) exo-type ?ident ?values)
@@ -695,4 +695,4 @@
;; [Resources]
(defn analyse [eval! compile-module compile-token]
(|do [asts &parser/parse]
- (&/flat-map% (partial analyse-ast eval! compile-module compile-token &type/$Void) asts)))
+ (&/flat-map% (partial analyse-ast eval! compile-module compile-token &/$VoidT) asts)))
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 62b2b5aad..00dbfb977 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -6,150 +6,149 @@
(ns lux.analyser.base
(:require clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [deftags |let |do return* return fail |case]]
+ (lux [base :as & :refer [defvariant |let |do return* return fail |case]]
[type :as &type])))
;; [Tags]
-(deftags
- ["bool"
- "int"
- "real"
- "char"
- "text"
- "variant"
- "tuple"
- "apply"
- "case"
- "lambda"
- "ann"
- "coerce"
- "def"
- "declare-macro"
- "var"
- "captured"
-
- "jvm-getstatic"
- "jvm-getfield"
- "jvm-putstatic"
- "jvm-putfield"
- "jvm-invokestatic"
- "jvm-instanceof"
- "jvm-invokevirtual"
- "jvm-invokeinterface"
- "jvm-invokespecial"
- "jvm-null?"
- "jvm-null"
- "jvm-new"
- "jvm-class"
- "jvm-interface"
- "jvm-try"
- "jvm-throw"
- "jvm-monitorenter"
- "jvm-monitorexit"
- "jvm-program"
-
-
- "jvm-znewarray"
- "jvm-zastore"
- "jvm-zaload"
- "jvm-bnewarray"
- "jvm-bastore"
- "jvm-baload"
- "jvm-snewarray"
- "jvm-sastore"
- "jvm-saload"
- "jvm-inewarray"
- "jvm-iastore"
- "jvm-iaload"
- "jvm-lnewarray"
- "jvm-lastore"
- "jvm-laload"
- "jvm-fnewarray"
- "jvm-fastore"
- "jvm-faload"
- "jvm-dnewarray"
- "jvm-dastore"
- "jvm-daload"
- "jvm-cnewarray"
- "jvm-castore"
- "jvm-caload"
- "jvm-anewarray"
- "jvm-aastore"
- "jvm-aaload"
- "jvm-arraylength"
-
- "jvm-iadd"
- "jvm-isub"
- "jvm-imul"
- "jvm-idiv"
- "jvm-irem"
- "jvm-ieq"
- "jvm-ilt"
- "jvm-igt"
-
- "jvm-ceq"
- "jvm-clt"
- "jvm-cgt"
-
- "jvm-ladd"
- "jvm-lsub"
- "jvm-lmul"
- "jvm-ldiv"
- "jvm-lrem"
- "jvm-leq"
- "jvm-llt"
- "jvm-lgt"
-
- "jvm-fadd"
- "jvm-fsub"
- "jvm-fmul"
- "jvm-fdiv"
- "jvm-frem"
- "jvm-feq"
- "jvm-flt"
- "jvm-fgt"
-
- "jvm-dadd"
- "jvm-dsub"
- "jvm-dmul"
- "jvm-ddiv"
- "jvm-drem"
- "jvm-deq"
- "jvm-dlt"
- "jvm-dgt"
-
- "jvm-d2f"
- "jvm-d2i"
- "jvm-d2l"
-
- "jvm-f2d"
- "jvm-f2i"
- "jvm-f2l"
-
- "jvm-i2b"
- "jvm-i2c"
- "jvm-i2d"
- "jvm-i2f"
- "jvm-i2l"
- "jvm-i2s"
-
- "jvm-l2d"
- "jvm-l2f"
- "jvm-l2i"
-
- "jvm-iand"
- "jvm-ior"
- "jvm-ixor"
- "jvm-ishl"
- "jvm-ishr"
- "jvm-iushr"
-
- "jvm-land"
- "jvm-lor"
- "jvm-lxor"
- "jvm-lshl"
- "jvm-lshr"
- "jvm-lushr"])
+(defvariant
+ ("bool" 1)
+ ("int" 1)
+ ("real" 1)
+ ("char" 1)
+ ("text" 1)
+ ("variant" 3)
+ ("tuple" 1)
+ ("apply" 1)
+ ("case" 1)
+ ("lambda" 1)
+ ("ann" 1)
+ ("coerce" 1)
+ ("def" 1)
+ ("declare-macro" 1)
+ ("var" 1)
+ ("captured" 1)
+
+ ("jvm-getstatic" 1)
+ ("jvm-getfield" 1)
+ ("jvm-putstatic" 1)
+ ("jvm-putfield" 1)
+ ("jvm-invokestatic" 1)
+ ("jvm-instanceof" 1)
+ ("jvm-invokevirtual" 1)
+ ("jvm-invokeinterface" 1)
+ ("jvm-invokespecial" 1)
+ ("jvm-null?" 1)
+ ("jvm-null" 0)
+ ("jvm-new" 1)
+ ("jvm-class" 1)
+ ("jvm-interface" 1)
+ ("jvm-try" 1)
+ ("jvm-throw" 1)
+ ("jvm-monitorenter" 1)
+ ("jvm-monitorexit" 1)
+ ("jvm-program" 1)
+
+ ("jvm-znewarray" 1)
+ ("jvm-zastore" 1)
+ ("jvm-zaload" 1)
+ ("jvm-bnewarray" 1)
+ ("jvm-bastore" 1)
+ ("jvm-baload" 1)
+ ("jvm-snewarray" 1)
+ ("jvm-sastore" 1)
+ ("jvm-saload" 1)
+ ("jvm-inewarray" 1)
+ ("jvm-iastore" 1)
+ ("jvm-iaload" 1)
+ ("jvm-lnewarray" 1)
+ ("jvm-lastore" 1)
+ ("jvm-laload" 1)
+ ("jvm-fnewarray" 1)
+ ("jvm-fastore" 1)
+ ("jvm-faload" 1)
+ ("jvm-dnewarray" 1)
+ ("jvm-dastore" 1)
+ ("jvm-daload" 1)
+ ("jvm-cnewarray" 1)
+ ("jvm-castore" 1)
+ ("jvm-caload" 1)
+ ("jvm-anewarray" 1)
+ ("jvm-aastore" 1)
+ ("jvm-aaload" 1)
+ ("jvm-arraylength" 1)
+
+ ("jvm-iadd" 1)
+ ("jvm-isub" 1)
+ ("jvm-imul" 1)
+ ("jvm-idiv" 1)
+ ("jvm-irem" 1)
+ ("jvm-ieq" 1)
+ ("jvm-ilt" 1)
+ ("jvm-igt" 1)
+
+ ("jvm-ceq" 1)
+ ("jvm-clt" 1)
+ ("jvm-cgt" 1)
+
+ ("jvm-ladd" 1)
+ ("jvm-lsub" 1)
+ ("jvm-lmul" 1)
+ ("jvm-ldiv" 1)
+ ("jvm-lrem" 1)
+ ("jvm-leq" 1)
+ ("jvm-llt" 1)
+ ("jvm-lgt" 1)
+
+ ("jvm-fadd" 1)
+ ("jvm-fsub" 1)
+ ("jvm-fmul" 1)
+ ("jvm-fdiv" 1)
+ ("jvm-frem" 1)
+ ("jvm-feq" 1)
+ ("jvm-flt" 1)
+ ("jvm-fgt" 1)
+
+ ("jvm-dadd" 1)
+ ("jvm-dsub" 1)
+ ("jvm-dmul" 1)
+ ("jvm-ddiv" 1)
+ ("jvm-drem" 1)
+ ("jvm-deq" 1)
+ ("jvm-dlt" 1)
+ ("jvm-dgt" 1)
+
+ ("jvm-d2f" 1)
+ ("jvm-d2i" 1)
+ ("jvm-d2l" 1)
+
+ ("jvm-f2d" 1)
+ ("jvm-f2i" 1)
+ ("jvm-f2l" 1)
+
+ ("jvm-i2b" 1)
+ ("jvm-i2c" 1)
+ ("jvm-i2d" 1)
+ ("jvm-i2f" 1)
+ ("jvm-i2l" 1)
+ ("jvm-i2s" 1)
+
+ ("jvm-l2d" 1)
+ ("jvm-l2f" 1)
+ ("jvm-l2i" 1)
+
+ ("jvm-iand" 1)
+ ("jvm-ior" 1)
+ ("jvm-ixor" 1)
+ ("jvm-ishl" 1)
+ ("jvm-ishr" 1)
+ ("jvm-iushr" 1)
+
+ ("jvm-land" 1)
+ ("jvm-lor" 1)
+ ("jvm-lxor" 1)
+ ("jvm-lshl" 1)
+ ("jvm-lshr" 1)
+ ("jvm-lushr" 1))
;; [Exports]
(defn expr-type* [analysis]
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 3480e50c6..2e58d7baf 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -6,7 +6,7 @@
(ns lux.analyser.case
(:require clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [deftags |do return fail |let |case]]
+ (lux [base :as & :refer [defvariant |do return fail |let |case]]
[parser :as &parser]
[type :as &type])
(lux.analyser [base :as &&]
@@ -15,31 +15,29 @@
[record :as &&record])))
;; [Tags]
-(deftags
- ["DefaultTotal"
- "BoolTotal"
- "IntTotal"
- "RealTotal"
- "CharTotal"
- "TextTotal"
- "TupleTotal"
- "VariantTotal"]
- )
-
-(deftags
- ["StoreTestAC"
- "BoolTestAC"
- "IntTestAC"
- "RealTestAC"
- "CharTestAC"
- "TextTestAC"
- "TupleTestAC"
- "VariantTestAC"]
- )
+(defvariant
+ ("DefaultTotal" 1)
+ ("BoolTotal" 2)
+ ("IntTotal" 2)
+ ("RealTotal" 2)
+ ("CharTotal" 2)
+ ("TextTotal" 2)
+ ("TupleTotal" 2)
+ ("VariantTotal" 2))
+
+(defvariant
+ ("StoreTestAC" 1)
+ ("BoolTestAC" 1)
+ ("IntTestAC" 1)
+ ("RealTestAC" 1)
+ ("CharTestAC" 1)
+ ("TextTestAC" 1)
+ ("TupleTestAC" 1)
+ ("VariantTestAC" 1))
;; [Utils]
(def ^:private unit
- (&/T [(&/T ["" -1 -1]) (&/V &/$TupleS &/Nil$)]))
+ (&/T [(&/T ["" -1 -1]) (&/$TupleS &/$Nil)]))
(defn ^:private resolve-type [type]
(|case type
@@ -67,7 +65,7 @@
(&type/with-var
(fn [$var]
(|do [=type (&type/apply-type type $var)
- ==type (adjust-type* (&/Cons$ (&/T [_aenv 1 $var]) (&/|map update-up-frame up)) =type)]
+ ==type (adjust-type* (&/$Cons (&/T [_aenv 1 $var]) (&/|map update-up-frame up)) =type)]
(&type/clean $var ==type))))
(&/$ExQ _aenv _abody)
@@ -78,14 +76,14 @@
(&/$ProdT ?left ?right)
(|do [=type (&/fold% (fn [_abody ena]
(|let [[_aenv _aidx (&/$VarT _avar)] ena]
- (|do [_ (&type/set-var _avar (&/V &/$BoundT _aidx))]
+ (|do [_ (&type/set-var _avar (&/$BoundT _aidx))]
(&type/clean* _avar _abody))))
type
up)
:let [distributor (fn [v]
(&/fold (fn [_abody ena]
(|let [[_aenv _aidx _avar] ena]
- (&/V &/$UnivQ (&/T [_aenv _abody]))))
+ (&/$UnivQ _aenv _abody)))
v
up))
adjusted-type (&type/Tuple$ (&/|map distributor (&type/flatten-prod =type)))]]
@@ -94,14 +92,14 @@
(&/$SumT ?left ?right)
(|do [=type (&/fold% (fn [_abody ena]
(|let [[_aenv _aidx (&/$VarT _avar)] ena]
- (|do [_ (&type/set-var _avar (&/V &/$BoundT _aidx))]
+ (|do [_ (&type/set-var _avar (&/$BoundT _aidx))]
(&type/clean* _avar _abody))))
type
up)
:let [distributor (fn [v]
(&/fold (fn [_abody ena]
(|let [[_aenv _aidx _avar] ena]
- (&/V &/$UnivQ (&/T [_aenv _abody]))))
+ (&/$UnivQ _aenv _abody)))
v
up))
adjusted-type (&type/Variant$ (&/|map distributor (&type/flatten-sum =type)))]]
@@ -128,7 +126,7 @@
(defn adjust-type [type]
"(-> Type (Lux Type))"
- (adjust-type* &/Nil$ type))
+ (adjust-type* &/$Nil type))
(defn ^:private analyse-pattern [var?? value-type pattern kont]
(|let [[meta pattern*] pattern]
@@ -138,13 +136,13 @@
(&/$Some var-analysis)
(|do [=kont (&env/with-alias name var-analysis
kont)]
- (return (&/T [(&/V $StoreTestAC -1) =kont])))
+ (return (&/T [($StoreTestAC -1) =kont])))
_
(|do [=kont (&env/with-local name value-type
kont)
idx &env/next-local-idx]
- (return (&/T [(&/V $StoreTestAC idx) =kont]))))
+ (return (&/T [($StoreTestAC idx) =kont]))))
(&/$SymbolS ident)
(fail (str "[Pattern-matching Error] Symbols must be unqualified: " (&/ident->text ident)))
@@ -152,34 +150,34 @@
(&/$BoolS ?value)
(|do [_ (&type/check value-type &type/Bool)
=kont kont]
- (return (&/T [(&/V $BoolTestAC ?value) =kont])))
+ (return (&/T [($BoolTestAC ?value) =kont])))
(&/$IntS ?value)
(|do [_ (&type/check value-type &type/Int)
=kont kont]
- (return (&/T [(&/V $IntTestAC ?value) =kont])))
+ (return (&/T [($IntTestAC ?value) =kont])))
(&/$RealS ?value)
(|do [_ (&type/check value-type &type/Real)
=kont kont]
- (return (&/T [(&/V $RealTestAC ?value) =kont])))
+ (return (&/T [($RealTestAC ?value) =kont])))
(&/$CharS ?value)
(|do [_ (&type/check value-type &type/Char)
=kont kont]
- (return (&/T [(&/V $CharTestAC ?value) =kont])))
+ (return (&/T [($CharTestAC ?value) =kont])))
(&/$TextS ?value)
(|do [_ (&type/check value-type &type/Text)
=kont kont]
- (return (&/T [(&/V $TextTestAC ?value) =kont])))
+ (return (&/T [($TextTestAC ?value) =kont])))
(&/$TupleS ?members)
(|case ?members
(&/$Nil)
- (|do [_ (&type/check value-type &type/Unit)
+ (|do [_ (&type/check value-type &/$UnitT)
=kont kont]
- (return (&/T [(&/V $TupleTestAC (&/|list)) =kont])))
+ (return (&/T [($TupleTestAC (&/|list)) =kont])))
(&/$Cons ?member (&/$Nil))
(analyse-pattern var?? value-type ?member kont)
@@ -197,19 +195,19 @@
(&/$Some ?member-types*)
(|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 [[=test [=tests =kont]] (analyse-pattern &/$None v m kont*)]
+ (return (&/T [(&/$Cons =test =tests) =kont])))))
(|do [=kont kont]
- (return (&/T [&/Nil$ =kont])))
+ (return (&/T [&/$Nil =kont])))
(&/|reverse (&/zip2 ?member-types* ?members)))]
- (return (&/T [(&/V $TupleTestAC =tests) =kont]))))
+ (return (&/T [($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)]
- (analyse-pattern &/None$ value-type (&/T [meta (&/V &/$TupleS rec-members)]) kont))
+ (analyse-pattern &/$None value-type (&/T [meta (&/$TupleS rec-members)]) kont))
(&/$TagS ?ident)
(|do [[=module =name] (&&/resolved-ident ?ident)
@@ -217,8 +215,8 @@
idx (&module/tag-index =module =name)
group (&module/tag-group =module =name)
case-type (&type/sum-at idx value-type*)
- [=test =kont] (analyse-pattern &/None$ case-type unit kont)]
- (return (&/T [(&/V $VariantTestAC (&/T [idx (&/|length group) =test])) =kont])))
+ [=test =kont] (analyse-pattern &/$None case-type unit kont)]
+ (return (&/T [($VariantTestAC (&/T [idx (&/|length group) =test])) =kont])))
(&/$FormS (&/$Cons [_ (&/$TagS ?ident)]
?values))
@@ -228,11 +226,11 @@
group (&module/tag-group =module =name)
case-type (&type/sum-at idx value-type*)
[=test =kont] (case (int (&/|length ?values))
- 0 (analyse-pattern &/None$ case-type unit kont)
- 1 (analyse-pattern &/None$ case-type (&/|head ?values) kont)
+ 0 (analyse-pattern &/$None case-type unit kont)
+ 1 (analyse-pattern &/$None case-type (&/|head ?values) kont)
;; 1+
- (analyse-pattern &/None$ case-type (&/T [(&/T ["" -1 -1]) (&/V &/$TupleS ?values)]) kont))]
- (return (&/T [(&/V $VariantTestAC (&/T [idx (&/|length group) =test])) =kont])))
+ (analyse-pattern &/$None case-type (&/T [(&/T ["" -1 -1]) (&/$TupleS ?values)]) kont))]
+ (return (&/T [($VariantTestAC (&/T [idx (&/|length group) =test])) =kont])))
_
(fail (str "[Pattern-matching Error] Unrecognized pattern syntax: " (&/show-ast pattern)))
@@ -241,89 +239,89 @@
(defn ^:private analyse-branch [analyse exo-type var?? value-type pattern body patterns]
(|do [pattern+body (analyse-pattern var?? value-type pattern
(&&/analyse-1 analyse exo-type body))]
- (return (&/Cons$ pattern+body patterns))))
+ (return (&/$Cons pattern+body patterns))))
(defn ^:private merge-total [struct test+body]
(|let [[test ?body] test+body]
(|case [struct test]
[($DefaultTotal total?) ($StoreTestAC ?idx)]
- (return (&/V $DefaultTotal true))
+ (return ($DefaultTotal true))
[($BoolTotal total? ?values) ($StoreTestAC ?idx)]
- (return (&/V $BoolTotal (&/T [true ?values])))
+ (return ($BoolTotal true ?values))
[($IntTotal total? ?values) ($StoreTestAC ?idx)]
- (return (&/V $IntTotal (&/T [true ?values])))
+ (return ($IntTotal true ?values))
[($RealTotal total? ?values) ($StoreTestAC ?idx)]
- (return (&/V $RealTotal (&/T [true ?values])))
+ (return ($RealTotal true ?values))
[($CharTotal total? ?values) ($StoreTestAC ?idx)]
- (return (&/V $CharTotal (&/T [true ?values])))
+ (return ($CharTotal true ?values))
[($TextTotal total? ?values) ($StoreTestAC ?idx)]
- (return (&/V $TextTotal (&/T [true ?values])))
+ (return ($TextTotal true ?values))
[($TupleTotal total? ?values) ($StoreTestAC ?idx)]
- (return (&/V $TupleTotal (&/T [true ?values])))
+ (return ($TupleTotal true ?values))
[($VariantTotal total? ?values) ($StoreTestAC ?idx)]
- (return (&/V $VariantTotal (&/T [true ?values])))
+ (return ($VariantTotal true ?values))
[($DefaultTotal total?) ($BoolTestAC ?value)]
- (return (&/V $BoolTotal (&/T [total? (&/|list ?value)])))
+ (return ($BoolTotal total? (&/|list ?value)))
[($BoolTotal total? ?values) ($BoolTestAC ?value)]
- (return (&/V $BoolTotal (&/T [total? (&/Cons$ ?value ?values)])))
+ (return ($BoolTotal total? (&/$Cons ?value ?values)))
[($DefaultTotal total?) ($IntTestAC ?value)]
- (return (&/V $IntTotal (&/T [total? (&/|list ?value)])))
+ (return ($IntTotal total? (&/|list ?value)))
[($IntTotal total? ?values) ($IntTestAC ?value)]
- (return (&/V $IntTotal (&/T [total? (&/Cons$ ?value ?values)])))
+ (return ($IntTotal total? (&/$Cons ?value ?values)))
[($DefaultTotal total?) ($RealTestAC ?value)]
- (return (&/V $RealTotal (&/T [total? (&/|list ?value)])))
+ (return ($RealTotal total? (&/|list ?value)))
[($RealTotal total? ?values) ($RealTestAC ?value)]
- (return (&/V $RealTotal (&/T [total? (&/Cons$ ?value ?values)])))
+ (return ($RealTotal total? (&/$Cons ?value ?values)))
[($DefaultTotal total?) ($CharTestAC ?value)]
- (return (&/V $CharTotal (&/T [total? (&/|list ?value)])))
+ (return ($CharTotal total? (&/|list ?value)))
[($CharTotal total? ?values) ($CharTestAC ?value)]
- (return (&/V $CharTotal (&/T [total? (&/Cons$ ?value ?values)])))
+ (return ($CharTotal total? (&/$Cons ?value ?values)))
[($DefaultTotal total?) ($TextTestAC ?value)]
- (return (&/V $TextTotal (&/T [total? (&/|list ?value)])))
+ (return ($TextTotal total? (&/|list ?value)))
[($TextTotal total? ?values) ($TextTestAC ?value)]
- (return (&/V $TextTotal (&/T [total? (&/Cons$ ?value ?values)])))
+ (return ($TextTotal total? (&/$Cons ?value ?values)))
[($DefaultTotal total?) ($TupleTestAC ?tests)]
(|do [structs (&/map% (fn [t]
- (merge-total (&/V $DefaultTotal total?) (&/T [t ?body])))
+ (merge-total ($DefaultTotal total?) (&/T [t ?body])))
?tests)]
- (return (&/V $TupleTotal (&/T [total? structs]))))
+ (return ($TupleTotal total? structs)))
[($TupleTotal total? ?values) ($TupleTestAC ?tests)]
(if (.equals ^Object (&/|length ?values) (&/|length ?tests))
(|do [structs (&/map2% (fn [v t]
(merge-total v (&/T [t ?body])))
?values ?tests)]
- (return (&/V $TupleTotal (&/T [total? structs]))))
+ (return ($TupleTotal total? structs)))
(fail "[Pattern-matching Error] Inconsistent tuple-size."))
[($DefaultTotal total?) ($VariantTestAC ?tag ?count ?test)]
- (|do [sub-struct (merge-total (&/V $DefaultTotal total?)
+ (|do [sub-struct (merge-total ($DefaultTotal total?)
(&/T [?test ?body]))
- structs (|case (&/|list-put ?tag sub-struct (&/|repeat ?count (&/V $DefaultTotal total?)))
+ structs (|case (&/|list-put ?tag sub-struct (&/|repeat ?count ($DefaultTotal total?)))
(&/$Some list)
(return list)
(&/$None)
(fail "[Pattern-matching Error] YOLO"))]
- (return (&/V $VariantTotal (&/T [total? structs]))))
+ (return ($VariantTotal total? structs)))
[($VariantTotal total? ?branches) ($VariantTestAC ?tag ?count ?test)]
(|do [sub-struct (merge-total (|case (&/|at ?tag ?branches)
@@ -331,7 +329,7 @@
sub
(&/$None)
- (&/V $DefaultTotal total?))
+ ($DefaultTotal total?))
(&/T [?test ?body]))
structs (|case (&/|list-put ?tag sub-struct ?branches)
(&/$Some list)
@@ -339,7 +337,7 @@
(&/$None)
(fail "[Pattern-matching Error] YOLO"))]
- (return (&/V $VariantTotal (&/T [total? structs]))))
+ (return ($VariantTotal total? structs)))
)))
(defn check-totality+ [check-totality]
@@ -394,7 +392,7 @@
(|do [=structs (&/map% (check-totality+ check-totality) ?structs)
_ (&type/check value-type (|case (->> (&/|map &/|second =structs) (&/|reverse))
(&/$Cons last prevs)
- (&/fold (fn [right left] (&type/Prod$ left right))
+ (&/fold (fn [right left] (&/$ProdT left right))
last prevs)))]
(return (or ?total
(&/fold #(and %1 %2) true (&/|map &/|first =structs)))))
@@ -436,9 +434,9 @@
(|do [patterns (&/fold% (fn [patterns branch]
(|let [[pattern body] branch]
(analyse-branch analyse exo-type var?? value-type pattern body patterns)))
- &/Nil$
+ &/$Nil
branches)
- struct (&/fold% merge-total (&/V $DefaultTotal false) patterns)
+ struct (&/fold% merge-total ($DefaultTotal false) patterns)
? (check-totality value-type struct)]
(if ?
(return patterns)
diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj
index f6a1adfc6..bea4c8308 100644
--- a/src/lux/analyser/env.clj
+++ b/src/lux/analyser/env.clj
@@ -19,8 +19,8 @@
(let [old-mappings (->> state (&/get$ &/$envs) &/|head (&/get$ &/$locals) (&/get$ &/$mappings))
=return (body (&/update$ &/$envs
(fn [stack]
- (let [var-analysis (&&/|meta type &/empty-cursor (&/V &&/$var (&/V &/$Local (->> (&/|head stack) (&/get$ &/$locals) (&/get$ &/$counter)))))]
- (&/Cons$ (&/update$ &/$locals #(->> %
+ (let [var-analysis (&&/|meta type &/empty-cursor (&&/$var (&/$Local (->> (&/|head stack) (&/get$ &/$locals) (&/get$ &/$counter)))))]
+ (&/$Cons (&/update$ &/$locals #(->> %
(&/update$ &/$counter inc)
(&/update$ &/$mappings (fn [m] (&/|put name var-analysis m))))
(&/|head stack))
@@ -29,7 +29,7 @@
(|case =return
(&/$Right ?state ?value)
(return* (&/update$ &/$envs (fn [stack*]
- (&/Cons$ (&/update$ &/$locals #(->> %
+ (&/$Cons (&/update$ &/$locals #(->> %
(&/update$ &/$counter dec)
(&/set$ &/$mappings old-mappings))
(&/|head stack*))
@@ -45,7 +45,7 @@
(let [old-mappings (->> state (&/get$ &/$envs) &/|head (&/get$ &/$locals) (&/get$ &/$mappings))
=return (body (&/update$ &/$envs
(fn [stack]
- (&/Cons$ (&/update$ &/$locals #(->> %
+ (&/$Cons (&/update$ &/$locals #(->> %
(&/update$ &/$mappings (fn [m] (&/|put name var-analysis m))))
(&/|head stack))
(&/|tail stack)))
@@ -53,7 +53,7 @@
(|case =return
(&/$Right ?state ?value)
(return* (&/update$ &/$envs (fn [stack*]
- (&/Cons$ (&/update$ &/$locals #(->> %
+ (&/$Cons (&/update$ &/$locals #(->> %
(&/set$ &/$mappings old-mappings))
(&/|head stack*))
(&/|tail stack*)))
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 6df324c1d..42257e352 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -48,11 +48,11 @@
state* (->> state (&/update$ &/$host #(&/update$ &/$catching (partial &/|++ catches) %)))]
(|case (&/run-state body state*)
(&/$Left msg)
- (&/V &/$Left msg)
+ (&/$Left msg)
(&/$Right state** output)
- (&/V &/$Right (&/T [(->> state** (&/update$ &/$host #(&/set$ &/$catching old-catches %)))
- output]))))
+ (&/$Right (&/T [(->> state** (&/update$ &/$host #(&/set$ &/$catching old-catches %)))
+ output]))))
))
(defn ^:private ensure-object [type]
@@ -81,7 +81,7 @@
"(-> Type Type)"
(|case type
(&/$DataT class params)
- (&type/Data$ (&host-type/as-obj class) params)
+ (&/$DataT (&host-type/as-obj class) params)
_
type))
@@ -104,7 +104,7 @@
"(-> Type Type)"
(|case type
(&/$DataT name params)
- (&type/Data$ (as-otype name) params)
+ (&/$DataT (as-otype name) params)
_
type))
@@ -115,14 +115,14 @@
(if ?
(|do [real-type (&type/deref id)]
(return (&/T [idx real-type])))
- (return (&/T [(+ 2 idx) (&type/Bound$ idx)]))))))
+ (return (&/T [(+ 2 idx) (&/$BoundT idx)]))))))
(defn ^:private clean-gtype-vars [gtype-vars]
(|do [[_ clean-types] (&/fold% (fn [idx+types gtype-var]
(|do [:let [[idx types] idx+types]
[idx* real-type] (clean-gtype-var idx gtype-var)]
- (return (&/T [idx* (&/Cons$ real-type types)]))))
- (&/T [1 (&/|list)])
+ (return (&/T [idx* (&/$Cons real-type types)]))))
+ (&/T [1 &/$Nil])
gtype-vars)]
(return clean-types)))
@@ -131,24 +131,24 @@
(&/fold (fn [base-type type-arg]
(|case type-arg
(&/$BoundT _)
- (&type/Univ$ &type/empty-env base-type)
+ (&/$UnivQ &type/empty-env base-type)
_
base-type))
- (&type/Data$ class-name type-args)
+ (&/$DataT class-name type-args)
type-args))
;; [Resources]
(do-template [<name> <output-tag> <input-class> <output-class>]
- (let [input-type (&type/Data$ <input-class> &/Nil$)
- output-type (&type/Data$ <output-class> &/Nil$)]
+ (let [input-type (&/$DataT <input-class> &/$Nil)
+ output-type (&/$DataT <output-class> &/$Nil)]
(defn <name> [analyse exo-type x y]
(|do [=x (&&/analyse-1 analyse input-type x)
=y (&&/analyse-1 analyse input-type y)
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta output-type _cursor
- (&/V <output-tag> (&/T [=x =y]))))))))
+ (<output-tag> (&/T [=x =y]))))))))
analyse-jvm-iadd &&/$jvm-iadd "java.lang.Integer" "java.lang.Integer"
analyse-jvm-isub &&/$jvm-isub "java.lang.Integer" "java.lang.Integer"
@@ -196,7 +196,7 @@
(|case obj-type
(&/$DataT class targs)
(if (= (&/|length targs) (&/|length gvars))
- (|let [gtype-env (&/fold2 (fn [m ^TypeVariable g t] (&/Cons$ (&/T [(.getName g) t]) m))
+ (|let [gtype-env (&/fold2 (fn [m ^TypeVariable g t] (&/$Cons (&/T [(.getName g) t]) m))
(&/|table)
gvars
targs)]
@@ -209,12 +209,12 @@
(defn analyse-jvm-getstatic [analyse exo-type class field]
(|do [class-loader &/loader
[gvars gtype] (&host/lookup-static-field class-loader class field)
- =type (&host-type/instance-param &type/existential (&/|list) gtype)
+ =type (&host-type/instance-param &type/existential &/$Nil gtype)
:let [output-type =type]
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-getstatic (&/T [class field output-type])))))))
+ (&&/$jvm-getstatic (&/T [class field output-type])))))))
(defn analyse-jvm-getfield [analyse exo-type class field object]
(|do [class-loader &/loader
@@ -226,19 +226,19 @@
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-getfield (&/T [class field =object output-type])))))))
+ (&&/$jvm-getfield (&/T [class field =object output-type])))))))
(defn analyse-jvm-putstatic [analyse exo-type class field value]
(|do [class-loader &/loader
[gvars gtype] (&host/lookup-static-field class-loader class field)
:let [gclass (&host-type/gtype->gclass gtype)]
- =type (&host-type/instance-param &type/existential (&/|list) gtype)
+ =type (&host-type/instance-param &type/existential &/$Nil gtype)
=value (&&/analyse-1 analyse =type value)
- :let [output-type &type/Unit]
+ :let [output-type &/$UnitT]
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-putstatic (&/T [class field =value gclass =type])))))))
+ (&&/$jvm-putstatic (&/T [class field =value gclass =type])))))))
(defn analyse-jvm-putfield [analyse exo-type class field value object]
(|do [class-loader &/loader
@@ -249,11 +249,11 @@
:let [gclass (&host-type/gtype->gclass gtype)]
=type (analyse-field-access-helper obj-type gvars gtype)
=value (&&/analyse-1 analyse =type value)
- :let [output-type &type/Unit]
+ :let [output-type &/$UnitT]
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-putfield (&/T [class field =value gclass =object =type])))))))
+ (&&/$jvm-putfield (&/T [class field =value gclass =object =type])))))))
(defn analyse-jvm-instanceof [analyse exo-type class object]
(|do [=object (&&/analyse-1+ analyse object)
@@ -262,7 +262,7 @@
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta output-type _cursor
- (&/V &&/$jvm-instanceof (&/T [class =object])))))))
+ (&&/$jvm-instanceof (&/T [class =object])))))))
(defn ^:private analyse-method-call-helper [analyse gret gtype-env gtype-vars gtype-args args]
(|case gtype-vars
@@ -276,14 +276,14 @@
(&/$Cons ^TypeVariable gtv gtype-vars*)
(&type/with-var
(fn [$var]
- (|do [:let [gtype-env* (&/Cons$ (&/T [(.getName gtv) $var]) gtype-env)]
+ (|do [:let [gtype-env* (&/$Cons (&/T [(.getName gtv) $var]) gtype-env)]
[=gret =args] (analyse-method-call-helper analyse gret gtype-env* gtype-vars* gtype-args args)
==gret (&type/clean $var =gret)
==args (&/map% (partial &&/clean-analysis $var) =args)]
(return (&/T [==gret ==args])))))
))
-(let [dummy-type-param (&type/Data$ "java.lang.Object" (&/|list))]
+(let [dummy-type-param (&/$DataT "java.lang.Object" &/$Nil)]
(do-template [<name> <tag> <only-interface?>]
(defn <name> [analyse exo-type class method classes object args]
(|do [class-loader &/loader
@@ -295,13 +295,13 @@
(catch Exception e
(fail (str "[Analyser Error] Unknown class: " class))))
[gret exceptions parent-gvars gvars gargs] (if (= "<init>" method)
- (return (&/T [Void/TYPE &/Nil$ &/Nil$ &/Nil$ &/Nil$]))
+ (return (&/T [Void/TYPE &/$Nil &/$Nil &/$Nil &/$Nil]))
(&host/lookup-virtual-method class-loader class method classes))
_ (ensure-catching exceptions)
=object (&&/analyse-1+ analyse object)
[sub-class sub-params] (ensure-object (&&/expr-type* =object))
(&/$DataT super-class* super-params*) (&host-type/->super-type &type/existential class-loader class sub-class sub-params)
- :let [gtype-env (&/fold2 (fn [m ^TypeVariable g t] (&/Cons$ (&/T [(.getName g) t]) m))
+ :let [gtype-env (&/fold2 (fn [m ^TypeVariable g t] (&/$Cons (&/T [(.getName g) t]) m))
(&/|table)
parent-gvars
super-params*)]
@@ -309,7 +309,7 @@
_ (&type/check exo-type (as-otype+ output-type))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V <tag> (&/T [class method classes =object =args output-type])))))))
+ (<tag> (&/T [class method classes =object =args output-type])))))))
analyse-jvm-invokevirtual &&/$jvm-invokevirtual false
analyse-jvm-invokespecial &&/$jvm-invokespecial false
@@ -325,7 +325,7 @@
_ (&type/check exo-type (as-otype+ output-type))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-invokestatic (&/T [class method classes =args output-type])))))))
+ (&&/$jvm-invokestatic (&/T [class method classes =args output-type])))))))
(defn analyse-jvm-null? [analyse exo-type object]
(|do [=object (&&/analyse-1+ analyse object)
@@ -334,14 +334,14 @@
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta output-type _cursor
- (&/V &&/$jvm-null? =object))))))
+ (&&/$jvm-null? =object))))))
(defn analyse-jvm-null [analyse exo-type]
- (|do [:let [output-type (&type/Data$ &host-type/null-data-tag &/Nil$)]
+ (|do [:let [output-type (&/$DataT &host-type/null-data-tag &/$Nil)]
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta output-type _cursor
- (&/V &&/$jvm-null &/unit-tag))))))
+ &&/$jvm-null)))))
(defn ^:private analyse-jvm-new-helper [analyse gtype gtype-env gtype-vars gtype-args args]
(|case gtype-vars
@@ -355,7 +355,7 @@
(&/$Cons ^TypeVariable gtv gtype-vars*)
(&type/with-var
(fn [$var]
- (|do [:let [gtype-env* (&/Cons$ (&/T [(.getName gtv) $var]) gtype-env)]
+ (|do [:let [gtype-env* (&/$Cons (&/T [(.getName gtv) $var]) gtype-env)]
[=gret =args] (analyse-jvm-new-helper analyse gtype gtype-env* gtype-vars* gtype-args args)
==gret (&type/clean $var =gret)
==args (&/map% (partial &&/clean-analysis $var) =args)]
@@ -370,19 +370,19 @@
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-new (&/T [class classes =args])))))))
+ (&&/$jvm-new (&/T [class classes =args])))))))
(let [length-type &type/Int
idx-type &type/Int]
(do-template [<class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>]
- (let [elem-type (&type/Data$ <class> &/Nil$)
- array-type (&type/Data$ &host-type/array-data-tag (&/|list elem-type))]
+ (let [elem-type (&/$DataT <class> &/$Nil)
+ array-type (&/$DataT &host-type/array-data-tag (&/|list elem-type))]
(defn <new-name> [analyse exo-type length]
(|do [=length (&&/analyse-1 analyse length-type length)
_ (&type/check exo-type array-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V <new-tag> =length))))))
+ (<new-tag> =length))))))
(defn <load-name> [analyse exo-type array idx]
(|do [=array (&&/analyse-1 analyse array-type array)
@@ -390,7 +390,7 @@
_ (&type/check exo-type elem-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V <load-tag> (&/T [=array =idx])))))))
+ (<load-tag> (&/T [=array =idx])))))))
(defn <store-name> [analyse exo-type array idx elem]
(|do [=array (&&/analyse-1 analyse array-type array)
@@ -399,7 +399,7 @@
_ (&type/check exo-type array-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V <store-tag> (&/T [=array =idx =elem])))))))
+ (<store-tag> (&/T [=array =idx =elem])))))))
)
"java.lang.Boolean" analyse-jvm-znewarray &&/$jvm-znewarray analyse-jvm-zaload &&/$jvm-zaload analyse-jvm-zastore &&/$jvm-zastore
@@ -417,12 +417,12 @@
(defn analyse-jvm-anewarray [analyse exo-type gclass length]
(|do [gtype-env &/get-type-env
=gclass (&host-type/instance-gtype &type/existential gtype-env gclass)
- :let [array-type (&type/Data$ &host-type/array-data-tag (&/|list =gclass))]
+ :let [array-type (&/$DataT &host-type/array-data-tag (&/|list =gclass))]
=length (&&/analyse-1 analyse length-type length)
_ (&type/check exo-type array-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-anewarray (&/T [gclass =length gtype-env])))))))
+ (&&/$jvm-anewarray (&/T [gclass =length gtype-env])))))))
(defn analyse-jvm-aaload [analyse exo-type array idx]
(|do [=array (&&/analyse-1+ analyse array)
@@ -433,7 +433,7 @@
_ (&type/check exo-type inner-arr-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-aaload (&/T [=array =idx])))))))
+ (&&/$jvm-aaload (&/T [=array =idx])))))))
(defn analyse-jvm-aastore [analyse exo-type array idx elem]
(|do [=array (&&/analyse-1+ analyse array)
@@ -446,7 +446,7 @@
_ (&type/check exo-type array-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-aastore (&/T [=array =idx =elem]))))))))
+ (&&/$jvm-aastore (&/T [=array =idx =elem]))))))))
(defn analyse-jvm-arraylength [analyse exo-type array]
(|do [=array (&&/analyse-1+ analyse array)
@@ -455,7 +455,7 @@
_ (&type/check exo-type &type/Int)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-arraylength =array)
+ (&&/$jvm-arraylength =array)
)))))
(defn generic-class->simple-class [gclass]
@@ -519,25 +519,25 @@
(&/$GenericClass name params)
(case name
- "boolean" (return (&type/Data$ "java.lang.Boolean" (&/|list)))
- "byte" (return (&type/Data$ "java.lang.Byte" (&/|list)))
- "short" (return (&type/Data$ "java.lang.Short" (&/|list)))
- "int" (return (&type/Data$ "java.lang.Integer" (&/|list)))
- "long" (return (&type/Data$ "java.lang.Long" (&/|list)))
- "float" (return (&type/Data$ "java.lang.Float" (&/|list)))
- "double" (return (&type/Data$ "java.lang.Double" (&/|list)))
- "char" (return (&type/Data$ "java.lang.Character" (&/|list)))
- "void" (return &type/Unit)
+ "boolean" (return (&/$DataT "java.lang.Boolean" &/$Nil))
+ "byte" (return (&/$DataT "java.lang.Byte" &/$Nil))
+ "short" (return (&/$DataT "java.lang.Short" &/$Nil))
+ "int" (return (&/$DataT "java.lang.Integer" &/$Nil))
+ "long" (return (&/$DataT "java.lang.Long" &/$Nil))
+ "float" (return (&/$DataT "java.lang.Float" &/$Nil))
+ "double" (return (&/$DataT "java.lang.Double" &/$Nil))
+ "char" (return (&/$DataT "java.lang.Character" &/$Nil))
+ "void" (return &/$UnitT)
;; else
(|do [=params (&/map% (partial generic-class->type env) params)]
- (return (&type/Data$ name =params))))
+ (return (&/$DataT name =params))))
(&/$GenericArray param)
(|do [=param (generic-class->type env param)]
- (return (&type/Data$ &host-type/array-data-tag (&/|list =param))))
+ (return (&/$DataT &host-type/array-data-tag (&/|list =param))))
(&/$GenericWildcard)
- (return (&type/Ex$ (&/|list) (&type/Bound$ 1)))
+ (return (&/$ExT &/$Nil (&/$BoundT 1)))
))
(defn gen-super-env [class-env supers class-decl]
@@ -546,8 +546,8 @@
(|case (&/|some (fn [super]
(|let [[super-name super-params] super]
(if (= class-name super-name)
- (&/Some$ (&/zip2 class-vars super-params))
- &/None$)))
+ (&/$Some (&/zip2 class-vars super-params))
+ &/$None)))
supers)
(&/$None)
(fail (str "[Analyser Error] Unrecognized super-class: " class-name))
@@ -563,7 +563,7 @@
(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 (&/V &/$DataT (&/T [?cname (&/|map &/|second class-env)]))]
+ class-type (&/$DataT ?cname (&/|map &/|second class-env))]
(|case method
(&/$ConstructorMethodSyntax =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body)
(|do [method-env (&/map% (fn [gvar]
@@ -571,7 +571,7 @@
(return (&/T [gvar ex]))))
?gvars)
:let [full-env (&/|++ class-env method-env)]
- :let [output-type &type/Unit]
+ :let [output-type &/$UnitT]
=ctor-args (&/map% (fn [ctor-arg]
(|do [:let [[ca-type ca-term] ctor-arg]
=ca-type (generic-class->type full-env ca-type)
@@ -587,7 +587,7 @@
body*)))
(&&/analyse-1 analyse output-type ?body)
(&/|reverse ?inputs))))]
- (return (&/V &/$ConstructorMethodAnalysis (&/T [=privacy-modifier ?anns ?gvars ?exceptions ?inputs =ctor-args =body]))))
+ (return (&/$ConstructorMethodAnalysis (&/T [=privacy-modifier ?anns ?gvars ?exceptions ?inputs =ctor-args =body]))))
(&/$VirtualMethodSyntax ?name =privacy-modifier =final? ?anns ?gvars ?exceptions ?inputs ?output ?body)
(|do [method-env (&/map% (fn [gvar]
@@ -605,7 +605,7 @@
body*)))
(&&/analyse-1 analyse output-type ?body)
(&/|reverse ?inputs))))]
- (return (&/V &/$VirtualMethodAnalysis (&/T [?name =privacy-modifier =final? ?anns ?gvars ?exceptions ?inputs ?output =body]))))
+ (return (&/$VirtualMethodAnalysis (&/T [?name =privacy-modifier =final? ?anns ?gvars ?exceptions ?inputs ?output =body]))))
(&/$OverridenMethodSyntax ?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output ?body)
(|do [super-env (gen-super-env class-env all-supers ?class-decl)
@@ -624,7 +624,7 @@
body*)))
(&&/analyse-1 analyse output-type ?body)
(&/|reverse ?inputs))))]
- (return (&/V &/$OverridenMethodAnalysis (&/T [?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output =body]))))
+ (return (&/$OverridenMethodAnalysis (&/T [?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output =body]))))
(&/$StaticMethodSyntax ?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output ?body)
(|do [method-env (&/map% (fn [gvar]
@@ -641,10 +641,10 @@
body*)))
(&&/analyse-1 analyse output-type ?body)
(&/|reverse ?inputs)))]
- (return (&/V &/$StaticMethodAnalysis (&/T [?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output =body]))))
+ (return (&/$StaticMethodAnalysis (&/T [?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output =body]))))
(&/$AbstractMethodSyntax ?name ?anns ?gvars ?exceptions ?inputs ?output)
- (return (&/V &/$AbstractMethodAnalysis (&/T [?name ?anns ?gvars ?exceptions ?inputs ?output])))
+ (return (&/$AbstractMethodAnalysis (&/T [?name ?anns ?gvars ?exceptions ?inputs ?output])))
)))
(defn ^:private mandatory-methods [supers]
@@ -699,72 +699,72 @@
(|do [module &/get-module-name
:let [[?name ?params] class-decl
full-name (str module "." ?name)
- all-supers (&/Cons$ super-class interfaces)]
+ all-supers (&/$Cons super-class interfaces)]
class-env (&/map% (fn [gvar]
(|do [ex &type/existential]
(return (&/T [gvar ex]))))
?params)
- _ (&host/use-dummy-class class-decl super-class interfaces &/None$ =fields methods)
+ _ (&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)
_ (check-method-completion all-supers =methods)
- _ (compile-token (&/V &&/$jvm-class (&/T [class-decl super-class interfaces =inheritance-modifier =anns =fields =methods (&/|list) &/None$])))
+ _ (compile-token (&&/$jvm-class (&/T [class-decl super-class interfaces =inheritance-modifier =anns =fields =methods &/$Nil &/$None])))
:let [_ (println 'DEF full-name)]]
- (return &/Nil$))))
+ (return &/$Nil))))
(defn analyse-jvm-interface [analyse compile-token interface-decl supers =anns =methods]
(|do [module &/get-module-name
- _ (compile-token (&/V &&/$jvm-interface (&/T [interface-decl supers =anns =methods])))
+ _ (compile-token (&&/$jvm-interface (&/T [interface-decl supers =anns =methods])))
:let [_ (println 'DEF (str module "." (&/|first interface-decl)))]]
- (return &/Nil$)))
+ (return &/$Nil)))
(defn ^:private captured-source [env-entry]
(|case env-entry
[name [_ (&&/$captured _ _ source)]]
source))
-(let [default-<init> (&/V &/$ConstructorMethodSyntax (&/T [(&/V &/$PublicPM &/unit-tag)
- (&/|list)
- (&/|list)
- (&/|list)
- (&/|list)
- (&/|list)
- (&/V &/$TupleS (&/|list))]))
+(let [default-<init> (&/$ConstructorMethodSyntax (&/T [&/$PublicPM
+ &/$Nil
+ &/$Nil
+ &/$Nil
+ &/$Nil
+ &/$Nil
+ (&/$TupleS &/$Nil)]))
captured-slot-class "java.lang.Object"
- captured-slot-type (&/V &/$GenericClass (&/T [captured-slot-class (&/|list)]))]
+ captured-slot-type (&/$GenericClass captured-slot-class &/$Nil)]
(defn analyse-jvm-anon-class [analyse compile-token exo-type super-class interfaces ctor-args methods]
(&/with-closure
(|do [module &/get-module-name
scope &/get-scope-name
:let [name (&host/location (&/|tail scope))
- class-decl (&/T [name (&/|list)])
+ class-decl (&/T [name &/$Nil])
anon-class (str module "." name)
- anon-class-type (&type/Data$ anon-class (&/|list))]
+ anon-class-type (&/$DataT anon-class &/$Nil)]
=ctor-args (&/map% (fn [ctor-arg]
(|let [[arg-type arg-term] ctor-arg]
(|do [=arg-term (&&/analyse-1+ analyse arg-term)]
(return (&/T [arg-type =arg-term])))))
ctor-args)
_ (->> methods
- (&/Cons$ default-<init>)
- (&host/use-dummy-class class-decl super-class interfaces (&/Some$ =ctor-args) (&/|list)))
- :let [all-supers (&/Cons$ super-class interfaces)
- class-env (&/|list)]
+ (&/$Cons default-<init>)
+ (&host/use-dummy-class class-decl super-class interfaces (&/$Some =ctor-args) &/$Nil))
+ :let [all-supers (&/$Cons super-class interfaces)
+ class-env &/$Nil]
=methods (&/map% (partial analyse-method analyse class-decl class-env all-supers) methods)
_ (check-method-completion all-supers =methods)
=captured &&env/captured-vars
:let [=fields (&/|map (fn [^objects idx+capt]
(|let [[idx _] idx+capt]
(&/T [(str &c!base/closure-prefix idx)
- (&/V &/$PublicPM &/unit-tag)
- (&/V &/$FinalSM &/unit-tag)
- (&/|list)
+ &/$PublicPM
+ &/$FinalSM
+ &/$Nil
captured-slot-type])))
(&/enumerate =captured))]
:let [sources (&/|map captured-source =captured)]
- _ (compile-token (&/V &&/$jvm-class (&/T [class-decl super-class interfaces (&/V &/$DefaultIM &/unit-tag) (&/|list) =fields =methods =captured (&/Some$ =ctor-args)])))
+ _ (compile-token (&&/$jvm-class (&/T [class-decl super-class interfaces &/$DefaultIM &/$Nil =fields =methods =captured (&/$Some =ctor-args)])))
_cursor &/cursor]
(return (&/|list (&&/|meta anon-class-type _cursor
- (&/V &&/$jvm-new (&/T [anon-class (&/|repeat (&/|length sources) captured-slot-class) sources]))
+ (&&/$jvm-new (&/T [anon-class (&/|repeat (&/|length sources) captured-slot-class) sources]))
)))
))))
@@ -772,7 +772,7 @@
(|do [:let [[?catches ?finally] ?catches+?finally]
=catches (&/map% (fn [_catch_]
(|do [:let [[?ex-class ?ex-arg ?catch-body] _catch_]
- =catch-body (&&env/with-local ?ex-arg (&type/Data$ ?ex-class &/Nil$)
+ =catch-body (&&env/with-local ?ex-arg (&/$DataT ?ex-class &/$Nil)
(&&/analyse-1 analyse exo-type ?catch-body))
idx &&env/next-local-idx]
(return (&/T [?ex-class idx =catch-body]))))
@@ -784,39 +784,39 @@
=body (with-catches catched-exceptions
(&&/analyse-1 analyse exo-type ?body))
=finally (|case ?finally
- (&/$None) (return &/None$)
+ (&/$None) (return &/$None)
(&/$Some ?finally*) (|do [=finally (&&/analyse-1+ analyse ?finally*)]
- (return (&/V &/$Some =finally))))
+ (return (&/$Some =finally))))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-try (&/T [=body =catches =finally])))))))
+ (&&/$jvm-try (&/T [=body =catches =finally])))))))
(defn analyse-jvm-throw [analyse exo-type ?ex]
- (|do [=ex (&&/analyse-1 analyse (&type/Data$ "java.lang.Throwable" &/Nil$) ?ex)
+ (|do [=ex (&&/analyse-1 analyse (&/$DataT "java.lang.Throwable" &/$Nil) ?ex)
_cursor &/cursor
- _ (&type/check exo-type &type/$Void)]
- (return (&/|list (&&/|meta exo-type _cursor (&/V &&/$jvm-throw =ex))))))
+ _ (&type/check exo-type &/$VoidT)]
+ (return (&/|list (&&/|meta exo-type _cursor (&&/$jvm-throw =ex))))))
(do-template [<name> <tag>]
(defn <name> [analyse exo-type ?monitor]
(|do [=monitor (&&/analyse-1+ analyse ?monitor)
_ (ensure-object (&&/expr-type* =monitor))
- :let [output-type &type/Unit]
+ :let [output-type &/$UnitT]
_ (&type/check exo-type output-type)
_cursor &/cursor]
- (return (&/|list (&&/|meta output-type _cursor (&/V <tag> =monitor))))))
+ (return (&/|list (&&/|meta output-type _cursor (<tag> =monitor))))))
analyse-jvm-monitorenter &&/$jvm-monitorenter
analyse-jvm-monitorexit &&/$jvm-monitorexit
)
(do-template [<name> <tag> <from-class> <to-class>]
- (let [output-type (&type/Data$ <to-class> &/Nil$)]
+ (let [output-type (&/$DataT <to-class> &/$Nil)]
(defn <name> [analyse exo-type ?value]
- (|do [=value (&&/analyse-1 analyse (&type/Data$ <from-class> &/Nil$) ?value)
+ (|do [=value (&&/analyse-1 analyse (&/$DataT <from-class> &/$Nil) ?value)
_ (&type/check exo-type output-type)
_cursor &/cursor]
- (return (&/|list (&&/|meta output-type _cursor (&/V <tag> =value)))))))
+ (return (&/|list (&&/|meta output-type _cursor (<tag> =value)))))))
analyse-jvm-d2f &&/$jvm-d2f "java.lang.Double" "java.lang.Float"
analyse-jvm-d2i &&/$jvm-d2i "java.lang.Double" "java.lang.Integer"
@@ -839,12 +839,12 @@
)
(do-template [<name> <tag> <from-class> <to-class>]
- (let [output-type (&type/Data$ <to-class> &/Nil$)]
+ (let [output-type (&/$DataT <to-class> &/$Nil)]
(defn <name> [analyse exo-type ?value]
- (|do [=value (&&/analyse-1 analyse (&type/Data$ <from-class> &/Nil$) ?value)
+ (|do [=value (&&/analyse-1 analyse (&/$DataT <from-class> &/$Nil) ?value)
_ (&type/check exo-type output-type)
_cursor &/cursor]
- (return (&/|list (&&/|meta output-type _cursor (&/V <tag> =value)))))))
+ (return (&/|list (&&/|meta output-type _cursor (<tag> =value)))))))
analyse-jvm-iand &&/$jvm-iand "java.lang.Integer" "java.lang.Integer"
analyse-jvm-ior &&/$jvm-ior "java.lang.Integer" "java.lang.Integer"
@@ -861,11 +861,11 @@
analyse-jvm-lushr &&/$jvm-lushr "java.lang.Long" "java.lang.Integer"
)
-(let [input-type (&type/App$ &type/List &type/Text)
- output-type (&type/App$ &type/IO &type/Unit)]
+(let [input-type (&/$AppT &type/List &type/Text)
+ output-type (&/$AppT &type/IO &/$UnitT)]
(defn analyse-jvm-program [analyse compile-token ?args ?body]
(|do [=body (&/with-scope ""
(&&env/with-local ?args input-type
(&&/analyse-1 analyse output-type ?body)))
- _ (compile-token (&/V &&/$jvm-program =body))]
- (return &/Nil$))))
+ _ (compile-token (&&/$jvm-program =body))]
+ (return &/$Nil))))
diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj
index 8d94d4ab6..b47b803d0 100644
--- a/src/lux/analyser/lambda.clj
+++ b/src/lux/analyser/lambda.clj
@@ -24,9 +24,9 @@
(defn close-over [scope name register frame]
(|let [[[register-type register-cursor] _] register
register* (&&/|meta register-type register-cursor
- (&/V &&/$captured (&/T [scope
- (->> frame (&/get$ &/$closure) (&/get$ &/$counter))
- register])))]
+ (&&/$captured (&/T [scope
+ (->> frame (&/get$ &/$closure) (&/get$ &/$counter))
+ register])))]
(&/T [register* (&/update$ &/$closure #(->> %
(&/update$ &/$counter inc)
(&/update$ &/$mappings (fn [mps] (&/|put name register* mps))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 29cc253a8..a5e3b3290 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -31,23 +31,23 @@
(defn ^:private next-bound-type [type]
"(-> Type Type)"
- (&type/Bound$ (->> (count-univq type) (* 2) (+ 1))))
+ (&/$BoundT (->> (count-univq type) (* 2) (+ 1))))
(defn ^:private embed-inferred-input [input output]
"(-> Type Type Type)"
(|case output
(&/$UnivQ env output*)
- (&type/Univ$ env (embed-inferred-input input output*))
+ (&/$UnivQ env (embed-inferred-input input output*))
_
- (&type/Lambda$ input output)))
+ (&/$LambdaT input output)))
;; [Exports]
(defn analyse-unit [analyse ?exo-type]
(|do [_cursor &/cursor
- _ (&type/check ?exo-type &type/Unit)]
+ _ (&type/check ?exo-type &/$UnitT)]
(return (&/|list (&&/|meta ?exo-type _cursor
- (&/V &&/$tuple (&/|list)))))))
+ (&&/$tuple (&/|list)))))))
(defn analyse-tuple [analyse ?exo-type ?elems]
(|case ?elems
@@ -71,14 +71,14 @@
(&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))
+ [[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$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*)))
+ (return (&/$UnivQ &/$Nil tuple-type*)))
_
(&type/clean $var tuple-type))]
@@ -86,7 +86,7 @@
tuple-analysis))))))
_
- (analyse-tuple analyse (&/V &/$Right exo-type*) ?elems)))
+ (analyse-tuple analyse (&/$Right exo-type*) ?elems)))
(&/$Right exo-type)
(|do [unknown? (&type/unknown? exo-type)]
@@ -96,11 +96,11 @@
?elems)
_ (&type/check exo-type (|case (->> (&/|map &&/expr-type* =elems) (&/|reverse))
(&/$Cons last prevs)
- (&/fold (fn [right left] (&type/Prod$ left right))
+ (&/fold (fn [right left] (&/$ProdT left right))
last prevs)))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$tuple =elems)
+ (&&/$tuple =elems)
))))
(|do [exo-type* (&type/actual-type exo-type)]
(&/with-attempt
@@ -117,13 +117,13 @@
?elems)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$tuple =elems)
+ (&&/$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))]
+ [[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Right exo-type**) ?elems))]
(return (&/|list (&&/|meta exo-type tuple-cursor
tuple-analysis))))
@@ -145,7 +145,7 @@
(analyse exo-type ?value)
_
- (analyse-tuple analyse (&/V &/$Right exo-type) ?values))
+ (analyse-tuple analyse (&/$Right exo-type) ?values))
(fn [err]
(fail (str err "\n"
'analyse-variant-body " " (&type/show-type exo-type)
@@ -167,14 +167,14 @@
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)
- [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (analyse-variant analyse (&/V &/$Left exo-type**) idx is-last? ?values))
+ [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (analyse-variant analyse (&/$Left exo-type**) idx is-last? ?values))
=var (&type/resolve-type $var)
inferred-type (|case =var
(&/$VarT iid)
(|do [:let [=var* (next-bound-type variant-type)]
_ (&type/set-var iid =var*)
variant-type* (&type/clean $var variant-type)]
- (return (&type/Univ$ &/Nil$ variant-type*)))
+ (return (&/$UnivQ &/$Nil variant-type*)))
_
(&type/clean $var variant-type))]
@@ -182,7 +182,7 @@
variant-analysis))))))
_
- (analyse-variant analyse (&/V &/$Right exo-type*) idx is-last? ?values)))
+ (analyse-variant analyse (&/$Right exo-type*) idx is-last? ?values)))
(&/$Right exo-type)
(|do [exo-type* (|case exo-type
@@ -217,19 +217,19 @@
_cursor &/cursor]
(if (= 1 num-variant-types)
(return (&/|list =value))
- (return (&/|list (&&/|meta exo-type _cursor (&/V &&/$variant (&/T [idx is-last?* =value])))))
+ (return (&/|list (&&/|meta exo-type _cursor (&&/$variant idx is-last?* =value))))
))
(&/$UnivQ _)
(|do [$var &type/existential
exo-type** (&type/apply-type exo-type* $var)]
- (analyse-variant analyse (&/V &/$Right exo-type**) idx is-last? ?values))
+ (analyse-variant analyse (&/$Right exo-type**) idx is-last? ?values))
(&/$ExQ _)
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)
- =exprs (analyse-variant analyse (&/V &/$Right exo-type**) idx is-last? ?values)]
+ =exprs (analyse-variant analyse (&/$Right exo-type**) idx is-last? ?values)]
(&/map% (partial &&/clean-analysis $var) =exprs))))
_
@@ -250,14 +250,14 @@
(&/$VarT id)
(|do [? (&type/bound? id)]
(if ?
- (analyse-tuple analyse (&/V &/$Right exo-type) rec-members)
- (|do [[[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/V &/$Left rec-type) rec-members))
+ (analyse-tuple analyse (&/$Right exo-type) rec-members)
+ (|do [[[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Left rec-type) rec-members))
_ (&type/check exo-type tuple-type)]
(return (&/|list (&&/|meta exo-type tuple-cursor
tuple-analysis))))))
_
- (analyse-tuple analyse (&/V &/$Right exo-type) rec-members)
+ (analyse-tuple analyse (&/$Right exo-type) rec-members)
)))
(defn ^:private analyse-global [analyse exo-type module name]
@@ -268,7 +268,7 @@
(&type/check exo-type endo-type))
_cursor &/cursor]
(return (&/|list (&&/|meta endo-type _cursor
- (&/V &&/$var (&/V &/$Global (&/T [r-module r-name])))
+ (&&/$var (&/$Global (&/T [r-module r-name])))
)))))
(defn ^:private analyse-local [analyse exo-type name]
@@ -295,16 +295,16 @@
(fail* (str "[Analyser Error] Unknown global definition: " name)))
(&/$Cons top-outer _)
- (|let [scopes (&/|tail (&/folds #(&/Cons$ (&/get$ &/$name %2) %1)
+ (|let [scopes (&/|tail (&/folds #(&/$Cons (&/get$ &/$name %2) %1)
(&/|map #(&/get$ &/$name %) outer)
(&/|reverse inner)))
[=local inner*] (&/fold2 (fn [register+new-inner frame in-scope]
(|let [[register new-inner] register+new-inner
[register* frame*] (&&lambda/close-over (&/|reverse in-scope) name register frame)]
- (&/T [register* (&/Cons$ frame* new-inner)])))
+ (&/T [register* (&/$Cons frame* new-inner)])))
(&/T [(or (->> top-outer (&/get$ &/$locals) (&/get$ &/$mappings) (&/|get name))
(->> top-outer (&/get$ &/$closure) (&/get$ &/$mappings) (&/|get name)))
- &/Nil$])
+ &/$Nil])
(&/|reverse inner) scopes)]
((|do [_ (&type/check exo-type (&&/expr-type* =local))]
(return (&/|list =local)))
@@ -322,7 +322,7 @@
(|case ?args
(&/$Nil)
(|do [_ (&type/check exo-type fun-type)]
- (return (&/T [fun-type &/Nil$])))
+ (return (&/T [fun-type &/$Nil])))
(&/$Cons ?arg ?args*)
(|do [?fun-type* (&type/actual-type fun-type)]
@@ -339,7 +339,7 @@
(|do [? (&type/bound? ?id)
type** (if ?
(&type/clean $var =output-t)
- (|do [_ (&type/set-var ?id (&/V &/$BoundT 1))]
+ (|do [_ (&type/set-var ?id (&/$BoundT 1))]
(&type/clean $var =output-t)))]
(return (&/T [type** ==args])))
))))
@@ -355,7 +355,7 @@
(&&/analyse-1 analyse ?input-t ?arg)
(fn [err]
(fail (str err "\n" "[Analyser Error] Function expected: " (&type/show-type ?input-t)))))]
- (return (&/T [=output-t (&/Cons$ =arg =args)])))
+ (return (&/T [=output-t (&/$Cons =arg =args)])))
_
(fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*))))
@@ -367,7 +367,7 @@
(|do [:let [[[=fn-type =fn-cursor] =fn-form] =fn]
[=output-t =args] (analyse-apply* analyse exo-type =fn-type ?args)]
(return (&/|list (&&/|meta =output-t =fn-cursor
- (&/V &&/$apply (&/T [=fn =args]))
+ (&&/$apply (&/T [=fn =args]))
)))))
(defn analyse-apply [analyse exo-type =fn ?args]
@@ -379,14 +379,14 @@
(|case (&&meta/meta-get &&meta/macro?-tag ?meta)
(&/$Some _)
(|do [macro-expansion (fn [state] (-> ?value (.apply ?args) (.apply state)))
- ;; :let [[r-prefix r-name] real-name
- ;; _ (when (or (= "jvm-import" r-name)
- ;; ;; (= "@type" r-name)
- ;; )
- ;; (->> (&/|map &/show-ast macro-expansion)
- ;; (&/|interpose "\n")
- ;; (&/fold str "")
- ;; (prn (&/ident->text real-name))))]
+ :let [[r-prefix r-name] real-name
+ _ (when (or (= "defclass" r-name)
+ ;; (= "@type" r-name)
+ )
+ (->> (&/|map &/show-ast macro-expansion)
+ (&/|interpose "\n")
+ (&/fold str "")
+ (prn (&/ident->text real-name))))]
]
(&/flat-map% (partial analyse exo-type) macro-expansion))
@@ -404,14 +404,14 @@
=value (&&/analyse-1+ analyse ?value)
:let [var?? (|case =value
[_ (&&/$var =var-kind)]
- (&/Some$ =value)
+ (&/$Some =value)
_
- &/None$)]
+ &/$None)]
=match (&&case/analyse-branches analyse exo-type var?? (&&/expr-type* =value) (&/|as-pairs ?branches))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$case (&/T [=value =match]))
+ (&&/$case (&/T [=value =match]))
)))))
(defn analyse-lambda* [analyse exo-type ?self ?arg ?body]
@@ -426,7 +426,7 @@
(fn [$input]
(&type/with-var
(fn [$output]
- (|do [[[lambda-type lambda-cursor] lambda-analysis] (analyse-lambda* analyse (&type/Lambda$ $input $output) ?self ?arg ?body)
+ (|do [[[lambda-type lambda-cursor] lambda-analysis] (analyse-lambda* analyse (&/$LambdaT $input $output) ?self ?arg ?body)
=input (&type/resolve-type $input)
=output (&type/resolve-type $output)
inferred-type (|case =input
@@ -435,7 +435,7 @@
_ (&type/set-var iid =input*)
=output* (&type/clean $input =output)
=output** (&type/clean $output =output*)]
- (return (&type/Univ$ &/Nil$ (embed-inferred-input =input* =output**))))
+ (return (&/$UnivQ &/$Nil (embed-inferred-input =input* =output**))))
_
(|do [=output* (&type/clean $input =output)
@@ -468,7 +468,7 @@
(&&/analyse-1 analyse ?return-t ?body))
_cursor &/cursor]
(return (&&/|meta exo-type* _cursor
- (&/V &&/$lambda (&/T [=scope =captured =body])))))
+ (&&/$lambda (&/T [=scope =captured =body])))))
@@ -515,8 +515,8 @@
==meta (eval! =meta)
_ (&&module/test-type module-name ?name ==meta (&&/expr-type* =value))
_ (&&module/test-macro module-name ?name ==meta (&&/expr-type* =value))
- _ (compile-token (&/V &&/$def (&/T [?name =value ==meta])))]
- (return &/Nil$))
+ _ (compile-token (&&/$def (&/T [?name =value ==meta])))]
+ (return &/$Nil))
)))
(defn analyse-import [analyse compile-module compile-token path]
@@ -532,12 +532,12 @@
_ (if (not already-compiled?)
(compile-module path)
(return nil))]
- (return &/Nil$)))))
+ (return &/$Nil)))))
(defn analyse-alias [analyse compile-token ex-alias ex-module]
(|do [module-name &/get-module-name
_ (&&module/alias module-name ex-alias ex-module)]
- (return &/Nil$)))
+ (return &/$Nil)))
(defn analyse-check [analyse eval! exo-type ?type ?value]
(|do [=type (&&/analyse-1 analyse &type/Type ?type)
@@ -546,7 +546,7 @@
=value (&&/analyse-1 analyse ==type ?value)
_cursor &/cursor]
(return (&/|list (&&/|meta ==type _cursor
- (&/V &&/$ann (&/T [=value =type ==type]))
+ (&&/$ann (&/T [=value =type ==type]))
)))))
(defn analyse-coerce [analyse eval! exo-type ?type ?value]
@@ -556,5 +556,5 @@
=value (&&/analyse-1+ analyse ?value)
_cursor &/cursor]
(return (&/|list (&&/|meta ==type _cursor
- (&/V &&/$coerce (&/T [=value =type ==type]))
+ (&&/$coerce (&/T [=value =type ==type]))
)))))
diff --git a/src/lux/analyser/meta.clj b/src/lux/analyser/meta.clj
index 185391678..3f2016f27 100644
--- a/src/lux/analyser/meta.clj
+++ b/src/lux/analyser/meta.clj
@@ -7,7 +7,7 @@
(:require (clojure [template :refer [do-template]])
clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [deftags |let |do return return* fail fail* |case]])))
+ (lux [base :as & :refer [|let |do return return* fail fail* |case]])))
;; [Utils]
(defn ^:private ident= [x y]
@@ -24,11 +24,11 @@
(|case dict
(&/$Cons [k v] dict*)
(if (ident= k ident)
- (&/Some$ v)
+ (&/$Some v)
(meta-get ident dict*))
(&/$Nil)
- &/None$
+ &/$None
_
(assert false (prn-str (&/adt->text ident)
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index 69635d4ad..1f980ba2c 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -9,14 +9,14 @@
[template :refer [do-template]])
clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [deftags |let |do return return* fail fail* |case]]
+ (lux [base :as & :refer [deftuple |let |do return return* fail fail* |case]]
[type :as &type]
[host :as &host])
[lux.host.generics :as &host-generics]
(lux.analyser [meta :as &meta])))
;; [Utils]
-(deftags
+(deftuple
["module-aliases"
"defs"
"imports"
@@ -29,7 +29,7 @@
;; "lux;defs"
(&/|table)
;; "lux;imports"
- &/Nil$
+ &/$Nil
;; "lux;tags"
(&/|table)
;; "lux;types"
@@ -44,7 +44,7 @@
(return* (&/update$ &/$modules
(fn [ms]
(&/|update current-module
- (fn [m] (&/update$ $imports (partial &/Cons$ module) m))
+ (fn [m] (&/update$ $imports (partial &/$Cons module) m))
ms))
state)
nil))))
diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj
index 8f142f86b..359894e75 100644
--- a/src/lux/analyser/parser.clj
+++ b/src/lux/analyser/parser.clj
@@ -38,18 +38,18 @@
(defn parse-gclass [ast]
(|case ast
[_ (&/$TextS "*")]
- (return (&/V &/$GenericWildcard &/unit-tag))
+ (return (&/$GenericWildcard &/unit-tag))
[_ (&/$TextS var-name)]
- (return (&/V &/$GenericTypeVar var-name))
+ (return (&/$GenericTypeVar var-name))
[_ (&/$FormS (&/$Cons [_ (&/$TextS class-name)] (&/$Cons [_ (&/$TupleS params)] (&/$Nil))))]
(|do [=params (&/map% parse-gclass params)]
- (return (&/V &/$GenericClass (&/T [class-name =params]))))
+ (return (&/$GenericClass class-name =params)))
[_ (&/$FormS (&/$Cons [_ (&/$TextS "Array")] (&/$Cons param (&/$Nil))))]
(|do [=param (parse-gclass param)]
- (return (&/V &/$GenericArray =param)))
+ (return (&/$GenericArray =param)))
_
(fail (str "[Analyser Error] Not generic class: " (&/show-ast ast)))))
@@ -85,7 +85,7 @@
[meta (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_finally")]
(&/$Cons ?finally-body
(&/$Nil))))]
- (return (&/T [catch+ (&/V &/$Some ?finally-body)]))
+ (return (&/T [catch+ (&/$Some ?finally-body)]))
_
(fail (str "[Analyser Error] Wrong syntax for exception handler: " (&/show-ast token))))))
@@ -149,16 +149,16 @@
(defn parse-privacy-modifier [ast]
(|case ast
[_ (&/$TextS "default")]
- (return (&/V &/$DefaultPM &/unit-tag))
+ (return &/$DefaultPM)
[_ (&/$TextS "public")]
- (return (&/V &/$PublicPM &/unit-tag))
+ (return &/$PublicPM)
[_ (&/$TextS "protected")]
- (return (&/V &/$ProtectedPM &/unit-tag))
+ (return &/$ProtectedPM)
[_ (&/$TextS "private")]
- (return (&/V &/$PrivatePM &/unit-tag))
+ (return &/$PrivatePM)
_
(fail (str "[Analyser Error] Invalid privacy modifier: " (&/show-ast ast)))))
@@ -166,13 +166,13 @@
(defn parse-state-modifier [ast]
(|case ast
[_ (&/$TextS "default")]
- (return (&/V &/$DefaultSM &/unit-tag))
+ (return &/$DefaultSM)
[_ (&/$TextS "volatile")]
- (return (&/V &/$VolatileSM &/unit-tag))
+ (return &/$VolatileSM)
[_ (&/$TextS "final")]
- (return (&/V &/$FinalSM &/unit-tag))
+ (return &/$FinalSM)
_
(fail (str "[Analyser Error] Invalid state modifier: " (&/show-ast ast)))))
@@ -180,13 +180,13 @@
(defn parse-inheritance-modifier [ast]
(|case ast
[_ (&/$TextS "default")]
- (return (&/V &/$DefaultIM &/unit-tag))
+ (return &/$DefaultIM)
[_ (&/$TextS "abstract")]
- (return (&/V &/$AbstractIM &/unit-tag))
+ (return &/$AbstractIM)
[_ (&/$TextS "final")]
- (return (&/V &/$FinalIM &/unit-tag))
+ (return &/$FinalIM)
_
(fail (str "[Analyser Error] Invalid inheritance modifier: " (&/show-ast ast)))))
@@ -207,7 +207,7 @@
=exceptions (&/map% parse-gclass exceptions)
=inputs (&/map% parse-arg-decl inputs)
=ctor-args (&/map% parse-ctor-arg ?ctor-args)]
- (return (&/V &/$ConstructorMethodSyntax (&/T [=privacy-modifier =anns =gvars =exceptions =inputs =ctor-args body]))))
+ (return (&/$ConstructorMethodSyntax (&/T [=privacy-modifier =anns =gvars =exceptions =inputs =ctor-args body]))))
_
(fail "")))
@@ -230,7 +230,7 @@
=exceptions (&/map% parse-gclass exceptions)
=inputs (&/map% parse-arg-decl inputs)
=output (parse-gclass output)]
- (return (&/V &/$VirtualMethodSyntax (&/T [?name =privacy-modifier =final? =anns =gvars =exceptions =inputs =output body]))))
+ (return (&/$VirtualMethodSyntax (&/T [?name =privacy-modifier =final? =anns =gvars =exceptions =inputs =output body]))))
_
(fail "")))
@@ -253,7 +253,7 @@
=exceptions (&/map% parse-gclass exceptions)
=inputs (&/map% parse-arg-decl inputs)
=output (parse-gclass output)]
- (return (&/V &/$OverridenMethodSyntax (&/T [=class-decl =name =anns =gvars =exceptions =inputs =output body]))))
+ (return (&/$OverridenMethodSyntax (&/T [=class-decl =name =anns =gvars =exceptions =inputs =output body]))))
_
(fail "")))
@@ -275,7 +275,7 @@
=exceptions (&/map% parse-gclass exceptions)
=inputs (&/map% parse-arg-decl inputs)
=output (parse-gclass output)]
- (return (&/V &/$StaticMethodSyntax (&/T [?name =privacy-modifier =anns =gvars =exceptions =inputs =output body]))))
+ (return (&/$StaticMethodSyntax (&/T [?name =privacy-modifier =anns =gvars =exceptions =inputs =output body]))))
_
(fail "")))
@@ -295,7 +295,7 @@
=exceptions (&/map% parse-gclass exceptions)
=inputs (&/map% parse-arg-decl inputs)
=output (parse-gclass output)]
- (return (&/V &/$AbstractMethodSyntax (&/T [?name =anns =gvars =exceptions =inputs =output]))))
+ (return (&/$AbstractMethodSyntax (&/T [?name =anns =gvars =exceptions =inputs =output]))))
_
(fail "")))
diff --git a/src/lux/analyser/record.clj b/src/lux/analyser/record.clj
index 67cc78c0c..8c8c657dc 100644
--- a/src/lux/analyser/record.clj
+++ b/src/lux/analyser/record.clj
@@ -6,7 +6,7 @@
(ns lux.analyser.record
(:require clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [deftags |let |do return fail |case]]
+ (lux [base :as & :refer [|let |do return fail |case]]
[type :as &type])
(lux.analyser [base :as &&]
[module :as &&module])))
@@ -16,7 +16,7 @@
"(-> (List (, Syntax Syntax)) (Lux (List Syntax)))"
(|do [[tag-group tag-type] (|case pairs
(&/$Nil)
- (return (&/T [&/Nil$ &type/Unit]))
+ (return (&/T [&/$Nil &/$UnitT]))
(&/$Cons [[_ (&/$TagS tag1)] _] _)
(|do [[module name] (&&/resolved-ident tag1)
diff --git a/src/lux/base.clj b/src/lux/base.clj
index e3d0a049e..96c1a82a6 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -9,80 +9,119 @@
clojure.core.match.array))
;; [Tags]
-(defmacro deftags [names]
+(def unit-tag (.intern (str (char 0) "unit" (char 0))))
+
+(defn T [elems]
+ (case (count elems)
+ 0
+ unit-tag
+
+ 1
+ (first elems)
+
+ ;; else
+ (to-array elems)))
+
+(defmacro defvariant [& names]
+ (assert (> (count names) 1))
+ `(do ~@(for [[[name num-params] idx] (map vector names (range (count names)))
+ :let [last-idx (dec (count names))
+ is-last? (if (= idx last-idx)
+ ""
+ nil)
+ def-name (with-meta (symbol (str "$" name))
+ {::idx idx
+ ::is-last? is-last?})]]
+ (cond (= 0 num-params)
+ `(def ~def-name
+ (to-array [(int ~idx) ~is-last? unit-tag]))
+
+ (= 1 num-params)
+ `(defn ~def-name [arg#]
+ (to-array [(int ~idx) ~is-last? arg#]))
+
+ :else
+ (let [g!args (map (fn [_] (gensym "arg"))
+ (range num-params))]
+ `(defn ~def-name [~@g!args]
+ (to-array [(int ~idx) ~is-last? (T [~@g!args])])))
+ ))))
+
+(defmacro deftuple [names]
(assert (vector? names))
`(do ~@(for [[name idx] (map vector names (range (count names)))]
- `(def ~(symbol (str "$" name)) ~idx))))
+ `(def ~(symbol (str "$" name))
+ (int ~idx)))))
;; List
-(deftags
- ["Nil"
- "Cons"])
+(defvariant
+ ("Nil" 0)
+ ("Cons" 2))
;; Maybe
-(deftags
- ["None"
- "Some"])
+(defvariant
+ ("None" 0)
+ ("Some" 1))
;; Either
-(deftags
- ["Left"
- "Right"])
+(defvariant
+ ("Left" 1)
+ ("Right" 1))
;; AST
-(deftags
- ["BoolS"
- "IntS"
- "RealS"
- "CharS"
- "TextS"
- "SymbolS"
- "TagS"
- "FormS"
- "TupleS"
- "RecordS"])
+(defvariant
+ ("BoolS" 1)
+ ("IntS" 1)
+ ("RealS" 1)
+ ("CharS" 1)
+ ("TextS" 1)
+ ("SymbolS" 1)
+ ("TagS" 1)
+ ("FormS" 1)
+ ("TupleS" 1)
+ ("RecordS" 1))
;; Type
-(deftags
- ["DataT"
- "VoidT"
- "UnitT"
- "SumT"
- "ProdT"
- "LambdaT"
- "BoundT"
- "VarT"
- "ExT"
- "UnivQ"
- "ExQ"
- "AppT"
- "NamedT"])
+(defvariant
+ ("DataT" 2)
+ ("VoidT" 0)
+ ("UnitT" 0)
+ ("SumT" 2)
+ ("ProdT" 2)
+ ("LambdaT" 2)
+ ("BoundT" 1)
+ ("VarT" 1)
+ ("ExT" 1)
+ ("UnivQ" 2)
+ ("ExQ" 2)
+ ("AppT" 2)
+ ("NamedT" 2))
;; Vars
-(deftags
- ["Local"
- "Global"])
+(defvariant
+ ("Local" 1)
+ ("Global" 1))
;; Binding
-(deftags
+(deftuple
["counter"
"mappings"])
;; Env
-(deftags
+(deftuple
["name"
"inner-closures"
"locals"
"closure"])
;; ModuleState
-(deftags
- ["Active"
- "Compiled"
- "Cached"])
+(defvariant
+ ("Active" 0)
+ ("Compiled" 0)
+ ("Cached" 0))
;; Host
-(deftags
+(deftuple
["writer"
"loader"
"classes"
@@ -91,7 +130,7 @@
"type-env"])
;; Compiler
-(deftags
+(deftuple
["source"
"cursor"
"modules"
@@ -103,56 +142,56 @@
"host"])
;; Compiler
-(deftags
- ["GenericTypeVar"
- "GenericClass"
- "GenericArray"
- "GenericWildcard"])
+(defvariant
+ ("GenericTypeVar" 1)
+ ("GenericClass" 2)
+ ("GenericArray" 1)
+ ("GenericWildcard" 1))
;; Privacy Modifiers
-(deftags
- ["DefaultPM"
- "PublicPM"
- "PrivatePM"
- "ProtectedPM"])
+(defvariant
+ ("DefaultPM" 0)
+ ("PublicPM" 0)
+ ("PrivatePM" 0)
+ ("ProtectedPM" 0))
;; State Modifiers
-(deftags
- ["DefaultSM"
- "VolatileSM"
- "FinalSM"])
+(defvariant
+ ("DefaultSM" 0)
+ ("VolatileSM" 0)
+ ("FinalSM" 0))
;; Inheritance Modifiers
-(deftags
- ["DefaultIM"
- "AbstractIM"
- "FinalIM"])
+(defvariant
+ ("DefaultIM" 0)
+ ("AbstractIM" 0)
+ ("FinalIM" 0))
;; Methods
-(deftags
- ["ConstructorMethodSyntax"
- "VirtualMethodSyntax"
- "OverridenMethodSyntax"
- "StaticMethodSyntax"
- "AbstractMethodSyntax"])
-
-(deftags
- ["ConstructorMethodAnalysis"
- "VirtualMethodAnalysis"
- "OverridenMethodAnalysis"
- "StaticMethodAnalysis"
- "AbstractMethodAnalysis"])
+(defvariant
+ ("ConstructorMethodSyntax" 1)
+ ("VirtualMethodSyntax" 1)
+ ("OverridenMethodSyntax" 1)
+ ("StaticMethodSyntax" 1)
+ ("AbstractMethodSyntax" 1))
+
+(defvariant
+ ("ConstructorMethodAnalysis" 1)
+ ("VirtualMethodAnalysis" 1)
+ ("OverridenMethodAnalysis" 1)
+ ("StaticMethodAnalysis" 1)
+ ("AbstractMethodAnalysis" 1))
;; Meta-data
-(deftags
- ["BoolM"
- "IntM"
- "RealM"
- "CharM"
- "TextM"
- "IdentM"
- "ListM"
- "DictM"])
+(defvariant
+ ("BoolM" 1)
+ ("IntM" 1)
+ ("RealM" 1)
+ ("CharM" 1)
+ ("TextM" 1)
+ ("IdentM" 1)
+ ("ListM" 1)
+ ("DictM" 1))
;; [Exports]
(def name-field "_name")
@@ -167,29 +206,8 @@
(def tags-field "_tags")
(def module-class-name "_")
(def +name-separator+ ";")
-(def unit-tag (.intern (str (char 0) "unit" (char 0))))
-
-(defn T [elems]
- (case (count elems)
- 0
- unit-tag
-
- 1
- (first elems)
-
- ;; else
- (to-array elems)))
-
-(defn V [^Long tag value]
- (to-array [(int tag) nil value]))
;; Constructors
-(def None$ (V $None unit-tag))
-(defn Some$ [x] (V $Some x))
-
-(def Nil$ (V $Nil unit-tag))
-(defn Cons$ [h t] (V $Cons (T [h t])))
-
(def empty-cursor (T ["" -1 -1]))
(defn get$ [slot ^objects record]
@@ -205,10 +223,10 @@
record#)))
(defn fail* [message]
- (V $Left message))
+ ($Left message))
(defn return* [state value]
- (V $Right (T [state value])))
+ ($Right (T [state value])))
(defn transform-pattern [pattern]
(cond (vector? pattern) (case (count pattern)
@@ -220,7 +238,9 @@
;; else
(mapv transform-pattern pattern))
- (seq? pattern) [(eval (first pattern))
+ (seq? pattern) [(-> (ns-resolve *ns* (first pattern))
+ meta
+ ::idx)
'_
(transform-pattern (vec (rest pattern)))]
:else pattern
@@ -247,14 +267,14 @@
(defmacro |list [& elems]
(reduce (fn [tail head]
- `(V $Cons (T [~head ~tail])))
- `Nil$
+ `($Cons ~head ~tail))
+ `$Nil
(reverse elems)))
(defmacro |table [& elems]
(reduce (fn [table [k v]]
`(|put ~k ~v ~table))
- `Nil$
+ `$Nil
(reverse (partition 2 elems))))
(defn |get [slot table]
@@ -270,12 +290,12 @@
(defn |put [slot value table]
(|case table
($Nil)
- (V $Cons (T [(T [slot value]) Nil$]))
+ ($Cons (T [slot value]) $Nil)
($Cons [k v] table*)
(if (.equals ^Object k slot)
- (V $Cons (T [(T [slot value]) table*]))
- (V $Cons (T [(T [k v]) (|put slot value table*)])))
+ ($Cons (T [slot value]) table*)
+ ($Cons (T [k v]) (|put slot value table*)))
))
(defn |remove [slot table]
@@ -286,7 +306,7 @@
($Cons [k v] table*)
(if (.equals ^Object k slot)
table*
- (V $Cons (T [(T [k v]) (|remove slot table*)])))))
+ ($Cons (T [k v]) (|remove slot table*)))))
(defn |update [k f table]
(|case table
@@ -295,8 +315,8 @@
($Cons [k* v] table*)
(if (.equals ^Object k k*)
- (V $Cons (T [(T [k* (f v)]) table*]))
- (V $Cons (T [(T [k* v]) (|update k f table*)])))))
+ ($Cons (T [k* (f v)]) table*)
+ ($Cons (T [k* v]) (|update k f table*)))))
(defn |head [xs]
(|case xs
@@ -317,11 +337,11 @@
;; [Resources/Monads]
(defn fail [message]
(fn [_]
- (V $Left message)))
+ ($Left message)))
(defn return [value]
(fn [state]
- (V $Right (T [state value]))))
+ ($Right (T [state value]))))
(defn bind [m-value step]
(fn [state]
@@ -361,7 +381,7 @@
ys
($Cons x xs*)
- (V $Cons (T [x (|++ xs* ys)]))))
+ ($Cons x (|++ xs* ys))))
(defn |map [f xs]
(|case xs
@@ -369,7 +389,7 @@
xs
($Cons x xs*)
- (V $Cons (T [(f x) (|map f xs*)]))))
+ ($Cons (f x) (|map f xs*))))
(defn |empty? [xs]
"(All [a] (-> (List a) Bool))"
@@ -388,7 +408,7 @@
($Cons x xs*)
(if (p x)
- (V $Cons (T [x (|filter p xs*)]))
+ ($Cons x (|filter p xs*))
(|filter p xs*))))
(defn flat-map [f xs]
@@ -408,8 +428,8 @@
($Cons x xs*)
(if (p x)
(|let [[pre post] (|split-with p xs*)]
- (T [(Cons$ x pre) post]))
- (T [Nil$ xs]))))
+ (T [($Cons x pre) post]))
+ (T [$Nil xs]))))
(defn |contains? [k table]
(|case table
@@ -451,15 +471,15 @@
(|list init)
($Cons x xs*)
- (Cons$ init (folds f (f init x) xs*))))
+ ($Cons init (folds f (f init x) xs*))))
(defn |length [xs]
(fold (fn [acc _] (inc acc)) 0 xs))
(let [|range* (fn |range* [from to]
(if (< from to)
- (V $Cons (T [from (|range* (inc from) to)]))
- Nil$))]
+ ($Cons from (|range* (inc from) to))
+ $Nil))]
(defn |range [n]
(|range* 0 n)))
@@ -474,26 +494,26 @@
(defn zip2 [xs ys]
(|case [xs ys]
[($Cons x xs*) ($Cons y ys*)]
- (V $Cons (T [(T [x y]) (zip2 xs* ys*)]))
+ ($Cons (T [x y]) (zip2 xs* ys*))
[_ _]
- Nil$))
+ $Nil))
(defn |keys [plist]
(|case plist
($Nil)
- Nil$
+ $Nil
($Cons [k v] plist*)
- (Cons$ k (|keys plist*))))
+ ($Cons k (|keys plist*))))
(defn |vals [plist]
(|case plist
($Nil)
- Nil$
+ $Nil
($Cons [k v] plist*)
- (Cons$ v (|vals plist*))))
+ ($Cons v (|vals plist*))))
(defn |interpose [sep xs]
(|case xs
@@ -504,7 +524,7 @@
xs
($Cons x xs*)
- (V $Cons (T [x (V $Cons (T [sep (|interpose sep xs*)]))]))))
+ ($Cons x ($Cons sep (|interpose sep xs*)))))
(do-template [<name> <joiner>]
(defn <name> [f xs]
@@ -517,24 +537,24 @@
ys (<name> f xs*)]
(return (<joiner> y ys)))))
- map% Cons$
+ map% $Cons
flat-map% |++)
(defn list-join [xss]
- (fold |++ Nil$ xss))
+ (fold |++ $Nil xss))
(defn |as-pairs [xs]
(|case xs
($Cons x ($Cons y xs*))
- (V $Cons (T [(T [x y]) (|as-pairs xs*)]))
+ ($Cons (T [x y]) (|as-pairs xs*))
_
- Nil$))
+ $Nil))
(defn |reverse [xs]
(fold (fn [tail head]
- (Cons$ head tail))
- Nil$
+ ($Cons head tail))
+ $Nil
xs))
(defn assert! [test message]
@@ -569,8 +589,8 @@
(defn repeat% [monad]
(try-all% (|list (|do [head monad
tail (repeat% monad)]
- (return (Cons$ head tail)))
- (return Nil$))))
+ (return ($Cons head tail)))
+ (return $Nil))))
(defn exhaust% [step]
(fn [state]
@@ -668,13 +688,13 @@
(defn host [_]
(let [store (atom {})]
(T [;; "lux;writer"
- (V $None unit-tag)
+ $None
;; "lux;loader"
(memory-class-loader store)
;; "lux;classes"
store
;; "lux;catching"
- Nil$
+ $Nil
;; "lux;module-states"
(|table)
;; lux;type-env
@@ -682,17 +702,17 @@
(defn init-state [_]
(T [;; "lux;source"
- (V $None unit-tag)
+ $None
;; "lux;cursor"
(T ["" -1 -1])
;; "lux;modules"
(|table)
;; "lux;envs"
- Nil$
+ $Nil
;; "lux;types"
+init-bindings+
;; "lux;expected"
- (V $VoidT unit-tag)
+ $VoidT
;; "lux;seed"
0
;; "lux;eval?"
@@ -758,13 +778,13 @@
(defn ->list [seq]
(if (empty? seq)
- Nil$
- (Cons$ (first seq) (->list (rest seq)))))
+ $Nil
+ ($Cons (first seq) (->list (rest seq)))))
(defn |repeat [n x]
(if (> n 0)
- (Cons$ x (|repeat (dec n) x))
- Nil$))
+ ($Cons x (|repeat (dec n) x))
+ $Nil))
(def get-module-name
(fn [state]
@@ -789,7 +809,7 @@
(defn with-scope [name body]
(fn [state]
- (let [output (body (update$ $envs #(Cons$ (env name) %) state))]
+ (let [output (body (update$ $envs #($Cons (env name) %) state))]
(|case output
($Right state* datum)
(return* (update$ $envs |tail state*) datum)
@@ -805,7 +825,7 @@
(return (->> top (get$ $inner-closures) str)))]
(fn [state]
(let [body* (with-scope closure-name body)]
- (run-state body* (update$ $envs #(Cons$ (update$ $inner-closures inc (|head %))
+ (run-state body* (update$ $envs #($Cons (update$ $inner-closures inc (|head %))
(|tail %))
state))))))
@@ -816,7 +836,7 @@
(defn with-writer [writer body]
(fn [state]
(let [old-writer (->> state (get$ $host) (get$ $writer))
- output (body (update$ $host #(set$ $writer (V $Some writer) %) state))]
+ output (body (update$ $host #(set$ $writer ($Some writer) %) state))]
(|case output
($Right ?state ?value)
(return* (update$ $host #(set$ $writer old-writer %) ?state)
@@ -922,10 +942,10 @@
[($Cons x xs*) ($Cons y ys*)]
(|do [z (f x y)
zs (map2% f xs* ys*)]
- (return (Cons$ z zs)))
+ (return ($Cons z zs)))
[($Nil) ($Nil)]
- (return Nil$)
+ (return $Nil)
[_ _]
(fail "Lists don't match in size.")))
@@ -933,10 +953,10 @@
(defn map2 [f xs ys]
(|case [xs ys]
[($Cons x xs*) ($Cons y ys*)]
- (Cons$ (f x y) (map2 f xs* ys*))
+ ($Cons (f x y) (map2 f xs* ys*))
[_ _]
- Nil$))
+ $Nil))
(defn fold2 [f init xs ys]
(|case [xs ys]
@@ -956,8 +976,8 @@
"(All [a] (-> Int (List a) (List (, Int a))))"
(|case xs
($Cons x xs*)
- (V $Cons (T [(T [idx x])
- (enumerate* (inc idx) xs*)]))
+ ($Cons (T [idx x])
+ (enumerate* (inc idx) xs*))
($Nil)
xs
@@ -983,16 +1003,16 @@
(|case xs
($Cons x xs*)
(cond (< idx 0)
- (V $None unit-tag)
+ $None
(= idx 0)
- (V $Some x)
+ ($Some x)
:else ;; > 1
(|at (dec idx) xs*))
($Nil)
- (V $None unit-tag)
+ $None
))
(defn normalize [ident]
@@ -1011,14 +1031,14 @@
(defn |list-put [idx val xs]
(|case xs
($Nil)
- (V $None unit-tag)
+ $None
($Cons x xs*)
(if (= idx 0)
- (V $Some (V $Cons (T [val xs*])))
+ ($Some ($Cons val xs*))
(|case (|list-put (dec idx) val xs*)
- ($None) (V $None unit-tag)
- ($Some xs**) (V $Some (V $Cons (T [x xs**]))))
+ ($None) $None
+ ($Some xs**) ($Some ($Cons x xs**)))
)))
(do-template [<flagger> <asker> <tag>]
@@ -1028,18 +1048,18 @@
(let [state* (update$ $host (fn [host]
(update$ $module-states
(fn [module-states]
- (|put module (V <tag> unit-tag) module-states))
+ (|put module <tag> module-states))
host))
state)]
- (V $Right (T [state* unit-tag])))))
+ ($Right (T [state* unit-tag])))))
(defn <asker> [module]
"(-> Text (Lux Bool))"
(fn [state]
(if-let [module-state (->> state (get$ $host) (get$ $module-states) (|get module))]
- (V $Right (T [state (|case module-state
- (<tag>) true
- _ false)]))
- (V $Right (T [state false])))
+ ($Right (T [state (|case module-state
+ (<tag>) true
+ _ false)]))
+ ($Right (T [state false])))
)))
flag-active-module active-module? $Active
@@ -1080,7 +1100,7 @@
"(All [a b] (-> (-> a (Maybe b)) (List a) (Maybe b)))"
(|case xs
($Nil)
- None$
+ $None
($Cons x xs*)
(|case (f x)
@@ -1100,26 +1120,26 @@
state)]
(|case (body state*)
($Right [state** output])
- (V $Right (T [(update$ $host
- #(set$ $type-env
- (->> state (get$ $host) (get$ $type-env))
- %)
- state**)
- output]))
+ ($Right (T [(update$ $host
+ #(set$ $type-env
+ (->> state (get$ $host) (get$ $type-env))
+ %)
+ state**)
+ output]))
($Left msg)
- (V $Left msg)))))
+ ($Left msg)))))
(defn |take [n xs]
(|case (T [n xs])
- [0 _] Nil$
- [_ ($Nil)] Nil$
- [_ ($Cons x xs*)] (Cons$ x (|take (dec n) xs*))
+ [0 _] $Nil
+ [_ ($Nil)] $Nil
+ [_ ($Cons x xs*)] ($Cons x (|take (dec n) xs*))
))
(defn |drop [n xs]
(|case (T [n xs])
[0 _] xs
- [_ ($Nil)] Nil$
+ [_ ($Nil)] $Nil
[_ ($Cons x xs*)] (|drop (dec n) xs*)
))
diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj
index 38592d16f..93f8bf3e9 100644
--- a/src/lux/compiler/cache.clj
+++ b/src/lux/compiler/cache.clj
@@ -98,7 +98,7 @@
_ (load _import (hash content) compile-module)]
(&/cached-module? _import)))
(if (= [""] imports)
- &/Nil$
+ &/$Nil
(&/->list imports)))]
(if (->> loads &/->seq (every? true?))
(do (doseq [^File file (seq (.listFiles (File. module-path)))
@@ -111,7 +111,7 @@
(let [defs (string/split (get-field &/defs-field module-meta) def-separator-re)
tag-groups (let [all-tags (get-field &/tags-field module-meta)]
(if (= "" all-tags)
- &/Nil$
+ &/$Nil
(-> all-tags
(string/split tag-group-separator-re)
(->> (map (fn [_group]
@@ -137,12 +137,12 @@
(let [[_ __module __name] (re-find #"^(.*);(.*)$" _alias)
def-class (&&/load-class! loader (str (&host-generics/->class-name __module) "." (&host/def-name __name)))
def-type (get-field &/type-field def-class)
- def-meta (&/|list (&/T [&a-meta/alias-tag (&/V &/$IdentM (&/T [__module __name]))]))
+ def-meta (&/|list (&/T [&a-meta/alias-tag (&/$IdentM (&/T [__module __name]))]))
def-value (get-field &/value-field def-class)]
(&a-module/define module _name def-type def-meta def-value)))
))
(if (= [""] defs)
- &/Nil$
+ &/$Nil
(&/->list defs)))
_ (&/map% (fn [group]
(|let [[_type _tags] group]
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index c7a7145f8..cd672b5ec 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -118,27 +118,33 @@
(&a-case/$VariantTestAC ?tag ?count ?test)
(if (= 1 ?count)
(compile-match ?test $target $else)
- (let [$variant-else (new Label)]
- (doto writer
- (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int ?tag))
- (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxUtils" "sum_get" "([Ljava/lang/Object;I)Ljava/lang/Object;")
- (.visitInsn Opcodes/DUP)
- (.visitInsn Opcodes/ACONST_NULL)
- (.visitJumpInsn Opcodes/IF_ACMPEQ $variant-else)
- (-> (doto (compile-match ?test $value-then $value-else)
- (.visitLabel $value-then)
+ (let [is-last (= ?tag (dec ?count))
+ $variant-else (new Label)
+ _ (doto writer
+ (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int ?tag)))
+ _ (if is-last
+ (.visitLdcInsn writer "")
+ (.visitInsn writer Opcodes/ACONST_NULL))
+ _ (doto writer
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxUtils" "sum_get" "([Ljava/lang/Object;ILjava/lang/Object;)Ljava/lang/Object;")
+ (.visitInsn Opcodes/DUP)
+ (.visitInsn Opcodes/ACONST_NULL)
+ (.visitJumpInsn Opcodes/IF_ACMPEQ $variant-else)
+ (-> (doto (compile-match ?test $value-then $value-else)
+ (.visitLabel $value-then)
+ (.visitInsn Opcodes/POP)
+ (.visitJumpInsn Opcodes/GOTO $target)
+ (.visitLabel $value-else)
+ (.visitInsn Opcodes/POP)
+ (.visitJumpInsn Opcodes/GOTO $else))
+ (->> (let [$value-then (new Label)
+ $value-else (new Label)])))
+ (.visitLabel $variant-else)
(.visitInsn Opcodes/POP)
- (.visitJumpInsn Opcodes/GOTO $target)
- (.visitLabel $value-else)
- (.visitInsn Opcodes/POP)
- (.visitJumpInsn Opcodes/GOTO $else))
- (->> (let [$value-then (new Label)
- $value-else (new Label)])))
- (.visitLabel $variant-else)
- (.visitInsn Opcodes/POP)
- (.visitJumpInsn Opcodes/GOTO $else))))
+ (.visitJumpInsn Opcodes/GOTO $else))]
+ writer))
))
(defn ^:private separate-bodies [patterns]
@@ -167,7 +173,8 @@
(.visitInsn Opcodes/POP)
(.visitTypeInsn Opcodes/NEW "java/lang/IllegalStateException")
(.visitInsn Opcodes/DUP)
- (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/IllegalStateException" "<init>" "()V")
+ (.visitLdcInsn "Invalid expression for pattern-matching.")
+ (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/IllegalStateException" "<init>" "(Ljava/lang/String;)V")
(.visitInsn Opcodes/ATHROW))
(&/map% (fn [?label+?body]
(|let [[?label ?body] ?label+?body]
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 6cfc87864..76e88e79f 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -497,7 +497,7 @@
(defn ^:private compile-method-def [compile ^ClassWriter class-writer ?super-class method-def]
(|case method-def
(&/$ConstructorMethodAnalysis ?privacy-modifier ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body)
- (|let [?output (&/V &/$GenericClass (&/T ["void" (&/|list)]))
+ (|let [?output (&/$GenericClass "void" (&/|list))
=method-decl (&/T [init-method ?anns ?gvars ?exceptions (&/|map &/|second ?inputs) ?output])
[simple-signature generic-signature] (&host-generics/method-signatures =method-decl)]
(&/with-writer (.visitMethod class-writer
@@ -680,7 +680,7 @@
(|do [module &/get-module-name
[file-name line column] &/cursor
:let [[?name ?params] class-decl
- class-signature (&host-generics/gclass-decl->signature class-decl (&/Cons$ ?super-class ?interfaces))
+ class-signature (&host-generics/gclass-decl->signature class-decl (&/$Cons ?super-class ?interfaces))
full-name (str module "/" ?name)
super-class* (&host-generics/->bytecode-class-name (&host-generics/super-class-name ?super-class))
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
@@ -718,7 +718,7 @@
(&&/save-class! interface-name (.toByteArray =interface))))
(def compile-Function-class
- (let [object-class (&/V &/$GenericClass (&/T ["java.lang.Object" (&/|list)]))
+ (let [object-class (&/$GenericClass "java.lang.Object" (&/|list))
interface-decl (&/T [(second (string/split &&/function-class #"/")) (&/|list)])
?supers (&/|list)
?anns (&/|list)
@@ -752,6 +752,7 @@
(doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "product_getLeft" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil)
(.visitCode)
(.visitLabel $begin)
+ (.visitFrame Opcodes/F_NEW (int 2) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER]) (int 0) (to-array []))
(.visitVarInsn Opcodes/ALOAD 0) ;; tuple
(.visitInsn Opcodes/ARRAYLENGTH) ;; tuple-size
(.visitVarInsn Opcodes/ILOAD 1) ;; tuple-size, index
@@ -786,6 +787,7 @@
(doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "product_getRight" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil)
(.visitCode)
(.visitLabel $begin)
+ (.visitFrame Opcodes/F_NEW (int 2) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER]) (int 0) (to-array []))
(.visitVarInsn Opcodes/ALOAD 0) ;; tuple
(.visitInsn Opcodes/ARRAYLENGTH) ;; tuple-size
(.visitVarInsn Opcodes/ILOAD 1) ;; tuple-size, index
@@ -812,6 +814,7 @@
(.visitVarInsn Opcodes/ASTORE 0) ;;
(.visitJumpInsn Opcodes/GOTO $begin)
(.visitLabel $must-copy)
+ (.visitFrame Opcodes/F_NEW (int 2) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER]) (int 0) (to-array []))
(.visitVarInsn Opcodes/ALOAD 0)
(.visitVarInsn Opcodes/ILOAD 1)
(.visitVarInsn Opcodes/ALOAD 0)
@@ -828,13 +831,14 @@
(.visitMaxs 0 0)
(.visitEnd)))
=sum-get-method (let [$begin (new Label)
+ $just-return (new Label)
$then (new Label)
$further (new Label)
$not-right (new Label)]
- (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "sum_get" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil)
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "sum_get" "([Ljava/lang/Object;ILjava/lang/Object;)Ljava/lang/Object;" nil nil)
(.visitCode)
- (.visitFrame Opcodes/F_NEW (int 2) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER]) (int 0) (to-array []))
(.visitLabel $begin)
+ (.visitFrame Opcodes/F_NEW (int 3) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER Opcodes/INTEGER]) (int 0) (to-array []))
(.visitVarInsn Opcodes/ILOAD 1) ;; tag
(.visitVarInsn Opcodes/ALOAD 0) ;; tag, sum
(.visitLdcInsn (int 0)) ;; tag, sum, sum-tag-idx
@@ -848,14 +852,22 @@
(.visitInsn Opcodes/ACONST_NULL)
(.visitInsn Opcodes/ARETURN)
(.visitLabel $then) ;; tag, sum-tag
- (.visitFrame Opcodes/F_NEW (int 2) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER]) (int 2) (to-array [Opcodes/INTEGER Opcodes/INTEGER]))
+ (.visitFrame Opcodes/F_NEW (int 3) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER Opcodes/INTEGER]) (int 2) (to-array [Opcodes/INTEGER Opcodes/INTEGER]))
+ (.visitVarInsn Opcodes/ALOAD 2) ;; tag, sum-tag, wants-last?
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitLdcInsn (int 1))
+ (.visitInsn Opcodes/AALOAD) ;; tag, sum-tag, wants-last?, is-last?
+ (.visitJumpInsn Opcodes/IF_ACMPEQ $just-return)
+ (.visitJumpInsn Opcodes/GOTO $further)
+ (.visitLabel $just-return)
+ (.visitFrame Opcodes/F_NEW (int 3) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER Opcodes/INTEGER]) (int 2) (to-array [Opcodes/INTEGER Opcodes/INTEGER]))
(.visitInsn Opcodes/POP2)
(.visitVarInsn Opcodes/ALOAD 0)
(.visitLdcInsn (int 2))
(.visitInsn Opcodes/AALOAD)
(.visitInsn Opcodes/ARETURN)
(.visitLabel $further) ;; tag, sum-tag
- (.visitFrame Opcodes/F_NEW (int 2) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER]) (int 2) (to-array [Opcodes/INTEGER Opcodes/INTEGER]))
+ (.visitFrame Opcodes/F_NEW (int 3) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER Opcodes/INTEGER]) (int 2) (to-array [Opcodes/INTEGER Opcodes/INTEGER]))
(.visitVarInsn Opcodes/ALOAD 0) ;; tag, sum-tag, sum
(.visitLdcInsn (int 1)) ;; tag, sum-tag, sum, last-index?
(.visitInsn Opcodes/AALOAD) ;; tag, sum-tag, last?
@@ -869,7 +881,7 @@
(.visitVarInsn Opcodes/ISTORE 1) ;;
(.visitJumpInsn Opcodes/GOTO $begin)
(.visitLabel $not-right) ;; tag, sum-tag
- (.visitFrame Opcodes/F_NEW (int 2) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER]) (int 2) (to-array [Opcodes/INTEGER Opcodes/INTEGER]))
+ (.visitFrame Opcodes/F_NEW (int 3) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER Opcodes/INTEGER]) (int 2) (to-array [Opcodes/INTEGER Opcodes/INTEGER]))
(.visitInsn Opcodes/POP2)
(.visitInsn Opcodes/ACONST_NULL)
(.visitInsn Opcodes/ARETURN)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 80bf065da..3003a0335 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -126,7 +126,7 @@
[[?def-type ?def-cursor] ?def-value]
(if (&type/type= &type/Type ?def-type)
(&/T [(&/T [?def-type ?def-cursor])
- (&/V &a/$tuple (&/|list))])
+ (&a/$tuple (&/|list))])
(&&type/type->analysis ?def-type)))]]
(compile ?def-type)))
diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj
index 8a63aaa17..2b9542919 100644
--- a/src/lux/compiler/type.clj
+++ b/src/lux/compiler/type.clj
@@ -14,19 +14,20 @@
;; [Utils]
(defn ^:private variant$ [tag body]
"(-> Int Analysis Analysis)"
- (&a/|meta &type/$Void &/empty-cursor
- (&/V &a/$variant (&/T [tag false body]))))
+ (let [tag-meta (meta tag)]
+ (&a/|meta &/$VoidT &/empty-cursor
+ (&a/$variant (::&/idx tag-meta) (::&/is-last? tag-meta) body))))
(defn ^:private tuple$ [members]
"(-> (List Analysis) Analysis)"
- (&a/|meta &type/$Void &/empty-cursor
- (&/V &a/$tuple members)))
+ (&a/|meta &/$VoidT &/empty-cursor
+ (&a/$tuple members)))
(do-template [<name> <tag> <doc>]
(defn <name> [value]
<doc>
- (&a/|meta &type/$Void &/empty-cursor
- (&/V <tag> value)))
+ (&a/|meta &/$VoidT &/empty-cursor
+ (<tag> value)))
^:private bool$ &a/$bool "(-> Bool Analysis)"
^:private int$ &a/$int "(-> Int Analysis)"
@@ -42,11 +43,11 @@
(def ^:private $Nil
"Analysis"
- (variant$ &/$Nil (tuple$ &/Nil$)))
+ (variant$ #'&/$Nil (tuple$ &/$Nil)))
(defn ^:private Cons$ [head tail]
"(-> Analysis Analysis Analysis)"
- (variant$ &/$Cons (tuple$ (&/|list head tail))))
+ (variant$ #'&/$Cons (tuple$ (&/|list head tail))))
(defn ^:private List$ [elems]
(&/fold (fn [tail head]
@@ -59,38 +60,38 @@
"(-> Type Analysis)"
(|case type
(&/$DataT class params)
- (variant$ &/$DataT (tuple$ (&/|list (text$ class)
- (List$ (&/|map type->analysis params)))))
+ (variant$ #'&/$DataT (tuple$ (&/|list (text$ class)
+ (List$ (&/|map type->analysis params)))))
(&/$VoidT)
- (variant$ &/$VoidT (tuple$ (&/|list)))
+ (variant$ #'&/$VoidT (tuple$ (&/|list)))
(&/$UnitT)
- (variant$ &/$UnitT (tuple$ (&/|list)))
+ (variant$ #'&/$UnitT (tuple$ (&/|list)))
(&/$ProdT left right)
- (variant$ &/$ProdT (tuple$ (&/|list (type->analysis left) (type->analysis right))))
+ (variant$ #'&/$ProdT (tuple$ (&/|list (type->analysis left) (type->analysis right))))
(&/$SumT left right)
- (variant$ &/$SumT (tuple$ (&/|list (type->analysis left) (type->analysis right))))
+ (variant$ #'&/$SumT (tuple$ (&/|list (type->analysis left) (type->analysis right))))
(&/$LambdaT input output)
- (variant$ &/$LambdaT (tuple$ (&/|list (type->analysis input) (type->analysis output))))
+ (variant$ #'&/$LambdaT (tuple$ (&/|list (type->analysis input) (type->analysis output))))
(&/$UnivQ env body)
- (variant$ &/$UnivQ
+ (variant$ #'&/$UnivQ
(tuple$ (&/|list (List$ (&/|map type->analysis env))
(type->analysis body))))
(&/$BoundT idx)
- (variant$ &/$BoundT (int$ idx))
+ (variant$ #'&/$BoundT (int$ idx))
(&/$AppT fun arg)
- (variant$ &/$AppT (tuple$ (&/|list (type->analysis fun) (type->analysis arg))))
+ (variant$ #'&/$AppT (tuple$ (&/|list (type->analysis fun) (type->analysis arg))))
(&/$NamedT [module name] type*)
- (variant$ &/$NamedT (tuple$ (&/|list (tuple$ (&/|list (text$ module) (text$ name)))
- (type->analysis type*))))
+ (variant$ #'&/$NamedT (tuple$ (&/|list (tuple$ (&/|list (text$ module) (text$ name)))
+ (type->analysis type*))))
_
(assert false (prn 'type->analysis (&/adt->text type)))
@@ -100,28 +101,28 @@
"(-> DefMetaValue Analysis)"
(|case dmv
(&/$BoolM value)
- (variant$ &/$BoolM (bool$ value))
+ (variant$ #'&/$BoolM (bool$ value))
(&/$IntM value)
- (variant$ &/$IntM (int$ value))
+ (variant$ #'&/$IntM (int$ value))
(&/$RealM value)
- (variant$ &/$RealM (real$ value))
+ (variant$ #'&/$RealM (real$ value))
(&/$CharM value)
- (variant$ &/$CharM (char$ value))
+ (variant$ #'&/$CharM (char$ value))
(&/$TextM value)
- (variant$ &/$TextM (text$ value))
+ (variant$ #'&/$TextM (text$ value))
(&/$IdentM value)
- (variant$ &/$IdentM (ident$ value))
+ (variant$ #'&/$IdentM (ident$ value))
(&/$ListM xs)
- (variant$ &/$ListM (List$ (&/|map defmetavalue->analysis xs)))
+ (variant$ #'&/$ListM (List$ (&/|map defmetavalue->analysis xs)))
(&/$DictM kvs)
- (variant$ &/$DictM
+ (variant$ #'&/$DictM
(List$ (&/|map (fn [kv]
(|let [[k v] kv]
(tuple$ (&/|list (text$ k)
diff --git a/src/lux/host.clj b/src/lux/host.clj
index abcd830c8..8b8996f52 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -155,7 +155,7 @@
(str (&/normalize-name name) "_" (hash name)))
(defn location [scope]
- (let [scope (&/Cons$ (def-name (&/|head scope))
+ (let [scope (&/$Cons (def-name (&/|head scope))
(&/|map &/normalize-name (&/|tail scope)))]
(->> scope
(&/|interpose "$")
@@ -274,7 +274,7 @@
(defn ^:private compile-dummy-method [^ClassWriter =class super-class method-def]
(|case method-def
(&/$ConstructorMethodSyntax =privacy-modifier =anns =gvars =exceptions =inputs =ctor-args body)
- (|let [=output (&/V &/$GenericClass (&/T ["void" (&/|list)]))
+ (|let [=output (&/$GenericClass "void" (&/|list))
method-decl [init-method-name =anns =gvars =exceptions (&/|map &/|second =inputs) =output]
[simple-signature generic-signature] (&host-generics/method-signatures method-decl)]
(doto (.visitMethod =class Opcodes/ACC_PUBLIC
@@ -368,7 +368,7 @@
(|do [module &/get-module-name
:let [[?name ?params] class-decl
full-name (str module "/" ?name)
- class-signature (&host-generics/gclass-decl->signature class-decl (&/Cons$ super-class interfaces))
+ class-signature (&host-generics/gclass-decl->signature class-decl (&/$Cons super-class interfaces))
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
full-name
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index 74efc9fc4..bac8675de 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -6,27 +6,27 @@
(ns lux.lexer
(:require (clojure [template :refer [do-template]]
[string :as string])
- (lux [base :as & :refer [deftags |do return* return fail fail*]]
+ (lux [base :as & :refer [defvariant |do return* return fail fail*]]
[reader :as &reader])
[lux.analyser.module :as &module]))
;; [Tags]
-(deftags
- ["White_Space"
- "Comment"
- "Bool"
- "Int"
- "Real"
- "Char"
- "Text"
- "Symbol"
- "Tag"
- "Open_Paren"
- "Close_Paren"
- "Open_Bracket"
- "Close_Bracket"
- "Open_Brace"
- "Close_Brace"]
+(defvariant
+ ("White_Space" 1)
+ ("Comment" 1)
+ ("Bool" 1)
+ ("Int" 1)
+ ("Real" 1)
+ ("Char" 1)
+ ("Text" 1)
+ ("Symbol" 1)
+ ("Tag" 1)
+ ("Open_Paren" 0)
+ ("Close_Paren" 0)
+ ("Open_Bracket" 0)
+ ("Close_Bracket" 0)
+ ("Open_Brace" 0)
+ ("Close_Brace" 0)
)
;; [Utils]
@@ -83,7 +83,7 @@
:let [[_ _ _column] meta]
token (lex-text-body (inc _column))
_ (&reader/read-text "\"")]
- (return (&/T [meta (&/V $Text token)]))))
+ (return (&/T [meta ($Text token)]))))
(def ^:private +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?]*)"
;; #"^([^0-9\[\]\(\)\{\};#\s\"][^\[\]\(\)\{\};#\s\"]*)"
@@ -92,12 +92,12 @@
;; [Lexers]
(def ^:private lex-white-space
(|do [[meta _ white-space] (&reader/read-regex #"^(\s+|$)")]
- (return (&/T [meta (&/V $White_Space white-space)]))))
+ (return (&/T [meta ($White_Space white-space)]))))
(def ^:private lex-single-line-comment
(|do [_ (&reader/read-text "##")
[meta _ comment] (&reader/read-regex #"^(.*)$")]
- (return (&/T [meta (&/V $Comment comment)]))))
+ (return (&/T [meta ($Comment comment)]))))
(defn ^:private lex-multi-line-comment [_]
(|do [_ (&reader/read-text "#(")
@@ -108,7 +108,7 @@
[_ post] (&reader/read-regex+ #"(?is)^((?!\)#).)*")]
(return (&/T [meta (str pre "#(" inner ")#" post)])))))
_ (&reader/read-text ")#")]
- (return (&/T [meta (&/V $Comment comment)]))))
+ (return (&/T [meta ($Comment comment)]))))
(def ^:private lex-comment
(&/try-all% (&/|list lex-single-line-comment
@@ -117,7 +117,7 @@
(do-template [<name> <tag> <regex>]
(def <name>
(|do [[meta _ token] (&reader/read-regex <regex>)]
- (return (&/T [meta (&/V <tag> token)]))))
+ (return (&/T [meta (<tag> token)]))))
^:private lex-bool $Bool #"^(true|false)"
^:private lex-int $Int #"^-?(0|[1-9][0-9]*)"
@@ -131,7 +131,7 @@
(|do [[_ _ char] (&reader/read-regex #"^(.)")]
(return char))))
_ (&reader/read-text "\"")]
- (return (&/T [meta (&/V $Char token)]))))
+ (return (&/T [meta ($Char token)]))))
(def ^:private lex-ident
(&/try-all% (&/|list (|do [[meta _ token] (&reader/read-regex +ident-re+)]
@@ -155,17 +155,17 @@
(def ^:private lex-symbol
(|do [[meta ident] lex-ident]
- (return (&/T [meta (&/V $Symbol ident)]))))
+ (return (&/T [meta ($Symbol ident)]))))
(def ^:private lex-tag
(|do [[meta _ _] (&reader/read-text "#")
[_ ident] lex-ident]
- (return (&/T [meta (&/V $Tag ident)]))))
+ (return (&/T [meta ($Tag ident)]))))
(do-template [<name> <text> <tag>]
(def <name>
(|do [[meta _ _] (&reader/read-text <text>)]
- (return (&/T [meta (&/V <tag> &/unit-tag)]))))
+ (return (&/T [meta <tag>]))))
^:private lex-open-paren "(" $Open_Paren
^:private lex-close-paren ")" $Close_Paren
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
index 66245750c..8f4625c6b 100644
--- a/src/lux/optimizer.clj
+++ b/src/lux/optimizer.clj
@@ -4,528 +4,528 @@
;; You can obtain one at http://mozilla.org/MPL/2.0/.
(ns lux.optimizer
- (:require (lux [base :as & :refer [|let |do return fail return* fail* |case deftags]]
+ (:require (lux [base :as & :refer [|let |do return fail return* fail* |case defvariant]]
[analyser :as &analyser])
[lux.analyser.base :as &-base]))
;; [Tags]
-(deftags
- ["bool"
- "int"
- "real"
- "char"
- "text"
- "variant"
- "tuple"
- "apply"
- "case"
- "lambda"
- "ann"
- "coerce"
- "def"
- "declare-macro"
- "var"
- "captured"
+(defvariant
+ ("bool" 1)
+ ("int" 1)
+ ("real" 1)
+ ("char" 1)
+ ("text" 1)
+ ("variant" 1)
+ ("tuple" 1)
+ ("apply" 1)
+ ("case" 1)
+ ("lambda" 1)
+ ("ann" 1)
+ ("coerce" 1)
+ ("def" 1)
+ ("declare-macro" 1)
+ ("var" 1)
+ ("captured" 1)
- "jvm-getstatic"
- "jvm-getfield"
- "jvm-putstatic"
- "jvm-putfield"
- "jvm-invokestatic"
- "jvm-instanceof"
- "jvm-invokevirtual"
- "jvm-invokeinterface"
- "jvm-invokespecial"
- "jvm-null?"
- "jvm-null"
- "jvm-new"
- "jvm-class"
- "jvm-interface"
- "jvm-try"
- "jvm-throw"
- "jvm-monitorenter"
- "jvm-monitorexit"
- "jvm-program"
+ ("jvm-getstatic" 1)
+ ("jvm-getfield" 1)
+ ("jvm-putstatic" 1)
+ ("jvm-putfield" 1)
+ ("jvm-invokestatic" 1)
+ ("jvm-instanceof" 1)
+ ("jvm-invokevirtual" 1)
+ ("jvm-invokeinterface" 1)
+ ("jvm-invokespecial" 1)
+ ("jvm-null?" 1)
+ ("jvm-null" 1)
+ ("jvm-new" 1)
+ ("jvm-class" 1)
+ ("jvm-interface" 1)
+ ("jvm-try" 1)
+ ("jvm-throw" 1)
+ ("jvm-monitorenter" 1)
+ ("jvm-monitorexit" 1)
+ ("jvm-program" 1)
- "jvm-znewarray"
- "jvm-zastore"
- "jvm-zaload"
- "jvm-bnewarray"
- "jvm-bastore"
- "jvm-baload"
- "jvm-snewarray"
- "jvm-sastore"
- "jvm-saload"
- "jvm-inewarray"
- "jvm-iastore"
- "jvm-iaload"
- "jvm-lnewarray"
- "jvm-lastore"
- "jvm-laload"
- "jvm-fnewarray"
- "jvm-fastore"
- "jvm-faload"
- "jvm-dnewarray"
- "jvm-dastore"
- "jvm-daload"
- "jvm-cnewarray"
- "jvm-castore"
- "jvm-caload"
- "jvm-anewarray"
- "jvm-aastore"
- "jvm-aaload"
- "jvm-arraylength"
-
- "jvm-iadd"
- "jvm-isub"
- "jvm-imul"
- "jvm-idiv"
- "jvm-irem"
- "jvm-ieq"
- "jvm-ilt"
- "jvm-igt"
+ ("jvm-znewarray" 1)
+ ("jvm-zastore" 1)
+ ("jvm-zaload" 1)
+ ("jvm-bnewarray" 1)
+ ("jvm-bastore" 1)
+ ("jvm-baload" 1)
+ ("jvm-snewarray" 1)
+ ("jvm-sastore" 1)
+ ("jvm-saload" 1)
+ ("jvm-inewarray" 1)
+ ("jvm-iastore" 1)
+ ("jvm-iaload" 1)
+ ("jvm-lnewarray" 1)
+ ("jvm-lastore" 1)
+ ("jvm-laload" 1)
+ ("jvm-fnewarray" 1)
+ ("jvm-fastore" 1)
+ ("jvm-faload" 1)
+ ("jvm-dnewarray" 1)
+ ("jvm-dastore" 1)
+ ("jvm-daload" 1)
+ ("jvm-cnewarray" 1)
+ ("jvm-castore" 1)
+ ("jvm-caload" 1)
+ ("jvm-anewarray" 1)
+ ("jvm-aastore" 1)
+ ("jvm-aaload" 1)
+ ("jvm-arraylength" 1)
+
+ ("jvm-iadd" 1)
+ ("jvm-isub" 1)
+ ("jvm-imul" 1)
+ ("jvm-idiv" 1)
+ ("jvm-irem" 1)
+ ("jvm-ieq" 1)
+ ("jvm-ilt" 1)
+ ("jvm-igt" 1)
- "jvm-ceq"
- "jvm-clt"
- "jvm-cgt"
+ ("jvm-ceq" 1)
+ ("jvm-clt" 1)
+ ("jvm-cgt" 1)
- "jvm-ladd"
- "jvm-lsub"
- "jvm-lmul"
- "jvm-ldiv"
- "jvm-lrem"
- "jvm-leq"
- "jvm-llt"
- "jvm-lgt"
+ ("jvm-ladd" 1)
+ ("jvm-lsub" 1)
+ ("jvm-lmul" 1)
+ ("jvm-ldiv" 1)
+ ("jvm-lrem" 1)
+ ("jvm-leq" 1)
+ ("jvm-llt" 1)
+ ("jvm-lgt" 1)
- "jvm-fadd"
- "jvm-fsub"
- "jvm-fmul"
- "jvm-fdiv"
- "jvm-frem"
- "jvm-feq"
- "jvm-flt"
- "jvm-fgt"
+ ("jvm-fadd" 1)
+ ("jvm-fsub" 1)
+ ("jvm-fmul" 1)
+ ("jvm-fdiv" 1)
+ ("jvm-frem" 1)
+ ("jvm-feq" 1)
+ ("jvm-flt" 1)
+ ("jvm-fgt" 1)
- "jvm-dadd"
- "jvm-dsub"
- "jvm-dmul"
- "jvm-ddiv"
- "jvm-drem"
- "jvm-deq"
- "jvm-dlt"
- "jvm-dgt"
+ ("jvm-dadd" 1)
+ ("jvm-dsub" 1)
+ ("jvm-dmul" 1)
+ ("jvm-ddiv" 1)
+ ("jvm-drem" 1)
+ ("jvm-deq" 1)
+ ("jvm-dlt" 1)
+ ("jvm-dgt" 1)
- "jvm-d2f"
- "jvm-d2i"
- "jvm-d2l"
+ ("jvm-d2f" 1)
+ ("jvm-d2i" 1)
+ ("jvm-d2l" 1)
- "jvm-f2d"
- "jvm-f2i"
- "jvm-f2l"
+ ("jvm-f2d" 1)
+ ("jvm-f2i" 1)
+ ("jvm-f2l" 1)
- "jvm-i2b"
- "jvm-i2c"
- "jvm-i2d"
- "jvm-i2f"
- "jvm-i2l"
- "jvm-i2s"
+ ("jvm-i2b" 1)
+ ("jvm-i2c" 1)
+ ("jvm-i2d" 1)
+ ("jvm-i2f" 1)
+ ("jvm-i2l" 1)
+ ("jvm-i2s" 1)
- "jvm-l2d"
- "jvm-l2f"
- "jvm-l2i"
+ ("jvm-l2d" 1)
+ ("jvm-l2f" 1)
+ ("jvm-l2i" 1)
- "jvm-iand"
- "jvm-ior"
- "jvm-ixor"
- "jvm-ishl"
- "jvm-ishr"
- "jvm-iushr"
+ ("jvm-iand" 1)
+ ("jvm-ior" 1)
+ ("jvm-ixor" 1)
+ ("jvm-ishl" 1)
+ ("jvm-ishr" 1)
+ ("jvm-iushr" 1)
- "jvm-land"
- "jvm-lor"
- "jvm-lxor"
- "jvm-lshl"
- "jvm-lshr"
- "jvm-lushr"])
+ ("jvm-land" 1)
+ ("jvm-lor" 1)
+ ("jvm-lxor" 1)
+ ("jvm-lshl" 1)
+ ("jvm-lshr" 1)
+ ("jvm-lushr" 1))
(defn ^:private optimize-token [analysis]
"(-> Analysis Optimized)"
(|case analysis
(&-base/$bool value)
- (return (&/V $bool value))
+ (return ($bool value))
(&-base/$int value)
- (return (&/V $int value))
+ (return ($int value))
(&-base/$real value)
- (return (&/V $real value))
+ (return ($real value))
(&-base/$char value)
- (return (&/V $char value))
+ (return ($char value))
(&-base/$text value)
- (return (&/V $text value))
+ (return ($text value))
(&-base/$variant value)
- (return (&/V $variant value))
+ (return ($variant value))
(&-base/$tuple value)
- (return (&/V $tuple value))
+ (return ($tuple value))
(&-base/$apply value)
- (return (&/V $apply value))
+ (return ($apply value))
(&-base/$case value)
- (return (&/V $case value))
+ (return ($case value))
(&-base/$lambda value)
- (return (&/V $lambda value))
+ (return ($lambda value))
(&-base/$ann value)
- (return (&/V $ann value))
+ (return ($ann value))
(&-base/$coerce value)
- (return (&/V $coerce value))
+ (return ($coerce value))
(&-base/$def value)
- (return (&/V $def value))
+ (return ($def value))
(&-base/$declare-macro value)
- (return (&/V $declare-macro value))
+ (return ($declare-macro value))
(&-base/$var value)
- (return (&/V $var value))
+ (return ($var value))
(&-base/$captured value)
- (return (&/V $captured value))
+ (return ($captured value))
(&-base/$jvm-getstatic value)
- (return (&/V $jvm-getstatic value))
+ (return ($jvm-getstatic value))
(&-base/$jvm-getfield value)
- (return (&/V $jvm-getfield value))
+ (return ($jvm-getfield value))
(&-base/$jvm-putstatic value)
- (return (&/V $jvm-putstatic value))
+ (return ($jvm-putstatic value))
(&-base/$jvm-putfield value)
- (return (&/V $jvm-putfield value))
+ (return ($jvm-putfield value))
(&-base/$jvm-invokestatic value)
- (return (&/V $jvm-invokestatic value))
+ (return ($jvm-invokestatic value))
(&-base/$jvm-instanceof value)
- (return (&/V $jvm-instanceof value))
+ (return ($jvm-instanceof value))
(&-base/$jvm-invokevirtual value)
- (return (&/V $jvm-invokevirtual value))
+ (return ($jvm-invokevirtual value))
(&-base/$jvm-invokeinterface value)
- (return (&/V $jvm-invokeinterface value))
+ (return ($jvm-invokeinterface value))
(&-base/$jvm-invokespecial value)
- (return (&/V $jvm-invokespecial value))
+ (return ($jvm-invokespecial value))
(&-base/$jvm-null? value)
- (return (&/V $jvm-null? value))
+ (return ($jvm-null? value))
(&-base/$jvm-null value)
- (return (&/V $jvm-null value))
+ (return ($jvm-null value))
(&-base/$jvm-new value)
- (return (&/V $jvm-new value))
+ (return ($jvm-new value))
(&-base/$jvm-class value)
- (return (&/V $jvm-class value))
+ (return ($jvm-class value))
(&-base/$jvm-interface value)
- (return (&/V $jvm-interface value))
+ (return ($jvm-interface value))
(&-base/$jvm-try value)
- (return (&/V $jvm-try value))
+ (return ($jvm-try value))
(&-base/$jvm-throw value)
- (return (&/V $jvm-throw value))
+ (return ($jvm-throw value))
(&-base/$jvm-monitorenter value)
- (return (&/V $jvm-monitorenter value))
+ (return ($jvm-monitorenter value))
(&-base/$jvm-monitorexit value)
- (return (&/V $jvm-monitorexit value))
+ (return ($jvm-monitorexit value))
(&-base/$jvm-program value)
- (return (&/V $jvm-program value))
+ (return ($jvm-program value))
(&-base/$jvm-znewarray value)
- (return (&/V $jvm-znewarray value))
+ (return ($jvm-znewarray value))
(&-base/$jvm-zastore value)
- (return (&/V $jvm-zastore value))
+ (return ($jvm-zastore value))
(&-base/$jvm-zaload value)
- (return (&/V $jvm-zaload value))
+ (return ($jvm-zaload value))
(&-base/$jvm-bnewarray value)
- (return (&/V $jvm-bnewarray value))
+ (return ($jvm-bnewarray value))
(&-base/$jvm-bastore value)
- (return (&/V $jvm-bastore value))
+ (return ($jvm-bastore value))
(&-base/$jvm-baload value)
- (return (&/V $jvm-baload value))
+ (return ($jvm-baload value))
(&-base/$jvm-snewarray value)
- (return (&/V $jvm-snewarray value))
+ (return ($jvm-snewarray value))
(&-base/$jvm-sastore value)
- (return (&/V $jvm-sastore value))
+ (return ($jvm-sastore value))
(&-base/$jvm-saload value)
- (return (&/V $jvm-saload value))
+ (return ($jvm-saload value))
(&-base/$jvm-inewarray value)
- (return (&/V $jvm-inewarray value))
+ (return ($jvm-inewarray value))
(&-base/$jvm-iastore value)
- (return (&/V $jvm-iastore value))
+ (return ($jvm-iastore value))
(&-base/$jvm-iaload value)
- (return (&/V $jvm-iaload value))
+ (return ($jvm-iaload value))
(&-base/$jvm-lnewarray value)
- (return (&/V $jvm-lnewarray value))
+ (return ($jvm-lnewarray value))
(&-base/$jvm-lastore value)
- (return (&/V $jvm-lastore value))
+ (return ($jvm-lastore value))
(&-base/$jvm-laload value)
- (return (&/V $jvm-laload value))
+ (return ($jvm-laload value))
(&-base/$jvm-fnewarray value)
- (return (&/V $jvm-fnewarray value))
+ (return ($jvm-fnewarray value))
(&-base/$jvm-fastore value)
- (return (&/V $jvm-fastore value))
+ (return ($jvm-fastore value))
(&-base/$jvm-faload value)
- (return (&/V $jvm-faload value))
+ (return ($jvm-faload value))
(&-base/$jvm-dnewarray value)
- (return (&/V $jvm-dnewarray value))
+ (return ($jvm-dnewarray value))
(&-base/$jvm-dastore value)
- (return (&/V $jvm-dastore value))
+ (return ($jvm-dastore value))
(&-base/$jvm-daload value)
- (return (&/V $jvm-daload value))
+ (return ($jvm-daload value))
(&-base/$jvm-cnewarray value)
- (return (&/V $jvm-cnewarray value))
+ (return ($jvm-cnewarray value))
(&-base/$jvm-castore value)
- (return (&/V $jvm-castore value))
+ (return ($jvm-castore value))
(&-base/$jvm-caload value)
- (return (&/V $jvm-caload value))
+ (return ($jvm-caload value))
(&-base/$jvm-anewarray value)
- (return (&/V $jvm-anewarray value))
+ (return ($jvm-anewarray value))
(&-base/$jvm-aastore value)
- (return (&/V $jvm-aastore value))
+ (return ($jvm-aastore value))
(&-base/$jvm-aaload value)
- (return (&/V $jvm-aaload value))
+ (return ($jvm-aaload value))
(&-base/$jvm-arraylength value)
- (return (&/V $jvm-arraylength value))
+ (return ($jvm-arraylength value))
(&-base/$jvm-iadd value)
- (return (&/V $jvm-iadd value))
+ (return ($jvm-iadd value))
(&-base/$jvm-isub value)
- (return (&/V $jvm-isub value))
+ (return ($jvm-isub value))
(&-base/$jvm-imul value)
- (return (&/V $jvm-imul value))
+ (return ($jvm-imul value))
(&-base/$jvm-idiv value)
- (return (&/V $jvm-idiv value))
+ (return ($jvm-idiv value))
(&-base/$jvm-irem value)
- (return (&/V $jvm-irem value))
+ (return ($jvm-irem value))
(&-base/$jvm-ieq value)
- (return (&/V $jvm-ieq value))
+ (return ($jvm-ieq value))
(&-base/$jvm-ilt value)
- (return (&/V $jvm-ilt value))
+ (return ($jvm-ilt value))
(&-base/$jvm-igt value)
- (return (&/V $jvm-igt value))
+ (return ($jvm-igt value))
(&-base/$jvm-ceq value)
- (return (&/V $jvm-ceq value))
+ (return ($jvm-ceq value))
(&-base/$jvm-clt value)
- (return (&/V $jvm-clt value))
+ (return ($jvm-clt value))
(&-base/$jvm-cgt value)
- (return (&/V $jvm-cgt value))
+ (return ($jvm-cgt value))
(&-base/$jvm-ladd value)
- (return (&/V $jvm-ladd value))
+ (return ($jvm-ladd value))
(&-base/$jvm-lsub value)
- (return (&/V $jvm-lsub value))
+ (return ($jvm-lsub value))
(&-base/$jvm-lmul value)
- (return (&/V $jvm-lmul value))
+ (return ($jvm-lmul value))
(&-base/$jvm-ldiv value)
- (return (&/V $jvm-ldiv value))
+ (return ($jvm-ldiv value))
(&-base/$jvm-lrem value)
- (return (&/V $jvm-lrem value))
+ (return ($jvm-lrem value))
(&-base/$jvm-leq value)
- (return (&/V $jvm-leq value))
+ (return ($jvm-leq value))
(&-base/$jvm-llt value)
- (return (&/V $jvm-llt value))
+ (return ($jvm-llt value))
(&-base/$jvm-lgt value)
- (return (&/V $jvm-lgt value))
+ (return ($jvm-lgt value))
(&-base/$jvm-fadd value)
- (return (&/V $jvm-fadd value))
+ (return ($jvm-fadd value))
(&-base/$jvm-fsub value)
- (return (&/V $jvm-fsub value))
+ (return ($jvm-fsub value))
(&-base/$jvm-fmul value)
- (return (&/V $jvm-fmul value))
+ (return ($jvm-fmul value))
(&-base/$jvm-fdiv value)
- (return (&/V $jvm-fdiv value))
+ (return ($jvm-fdiv value))
(&-base/$jvm-frem value)
- (return (&/V $jvm-frem value))
+ (return ($jvm-frem value))
(&-base/$jvm-feq value)
- (return (&/V $jvm-feq value))
+ (return ($jvm-feq value))
(&-base/$jvm-flt value)
- (return (&/V $jvm-flt value))
+ (return ($jvm-flt value))
(&-base/$jvm-fgt value)
- (return (&/V $jvm-fgt value))
+ (return ($jvm-fgt value))
(&-base/$jvm-dadd value)
- (return (&/V $jvm-dadd value))
+ (return ($jvm-dadd value))
(&-base/$jvm-dsub value)
- (return (&/V $jvm-dsub value))
+ (return ($jvm-dsub value))
(&-base/$jvm-dmul value)
- (return (&/V $jvm-dmul value))
+ (return ($jvm-dmul value))
(&-base/$jvm-ddiv value)
- (return (&/V $jvm-ddiv value))
+ (return ($jvm-ddiv value))
(&-base/$jvm-drem value)
- (return (&/V $jvm-drem value))
+ (return ($jvm-drem value))
(&-base/$jvm-deq value)
- (return (&/V $jvm-deq value))
+ (return ($jvm-deq value))
(&-base/$jvm-dlt value)
- (return (&/V $jvm-dlt value))
+ (return ($jvm-dlt value))
(&-base/$jvm-dgt value)
- (return (&/V $jvm-dgt value))
+ (return ($jvm-dgt value))
(&-base/$jvm-d2f value)
- (return (&/V $jvm-d2f value))
+ (return ($jvm-d2f value))
(&-base/$jvm-d2i value)
- (return (&/V $jvm-d2i value))
+ (return ($jvm-d2i value))
(&-base/$jvm-d2l value)
- (return (&/V $jvm-d2l value))
+ (return ($jvm-d2l value))
(&-base/$jvm-f2d value)
- (return (&/V $jvm-f2d value))
+ (return ($jvm-f2d value))
(&-base/$jvm-f2i value)
- (return (&/V $jvm-f2i value))
+ (return ($jvm-f2i value))
(&-base/$jvm-f2l value)
- (return (&/V $jvm-f2l value))
+ (return ($jvm-f2l value))
(&-base/$jvm-i2b value)
- (return (&/V $jvm-i2b value))
+ (return ($jvm-i2b value))
(&-base/$jvm-i2c value)
- (return (&/V $jvm-i2c value))
+ (return ($jvm-i2c value))
(&-base/$jvm-i2d value)
- (return (&/V $jvm-i2d value))
+ (return ($jvm-i2d value))
(&-base/$jvm-i2f value)
- (return (&/V $jvm-i2f value))
+ (return ($jvm-i2f value))
(&-base/$jvm-i2l value)
- (return (&/V $jvm-i2l value))
+ (return ($jvm-i2l value))
(&-base/$jvm-i2s value)
- (return (&/V $jvm-i2s value))
+ (return ($jvm-i2s value))
(&-base/$jvm-l2d value)
- (return (&/V $jvm-l2d value))
+ (return ($jvm-l2d value))
(&-base/$jvm-l2f value)
- (return (&/V $jvm-l2f value))
+ (return ($jvm-l2f value))
(&-base/$jvm-l2i value)
- (return (&/V $jvm-l2i value))
+ (return ($jvm-l2i value))
(&-base/$jvm-iand value)
- (return (&/V $jvm-iand value))
+ (return ($jvm-iand value))
(&-base/$jvm-ior value)
- (return (&/V $jvm-ior value))
+ (return ($jvm-ior value))
(&-base/$jvm-ixor value)
- (return (&/V $jvm-ixor value))
+ (return ($jvm-ixor value))
(&-base/$jvm-ishl value)
- (return (&/V $jvm-ishl value))
+ (return ($jvm-ishl value))
(&-base/$jvm-ishr value)
- (return (&/V $jvm-ishr value))
+ (return ($jvm-ishr value))
(&-base/$jvm-iushr value)
- (return (&/V $jvm-iushr value))
+ (return ($jvm-iushr value))
(&-base/$jvm-land value)
- (return (&/V $jvm-land value))
+ (return ($jvm-land value))
(&-base/$jvm-lor value)
- (return (&/V $jvm-lor value))
+ (return ($jvm-lor value))
(&-base/$jvm-lxor value)
- (return (&/V $jvm-lxor value))
+ (return ($jvm-lxor value))
(&-base/$jvm-lshl value)
- (return (&/V $jvm-lshl value))
+ (return ($jvm-lshl value))
(&-base/$jvm-lshr value)
- (return (&/V $jvm-lshr value))
+ (return ($jvm-lshr value))
(&-base/$jvm-lushr value)
- (return (&/V $jvm-lushr value))
+ (return ($jvm-lushr value))
))
;; [Exports]
diff --git a/src/lux/parser.clj b/src/lux/parser.clj
index 881619d4d..4fb42e0fa 100644
--- a/src/lux/parser.clj
+++ b/src/lux/parser.clj
@@ -7,7 +7,7 @@
(:require [clojure.template :refer [do-template]]
clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [deftags |do return fail |case]]
+ (lux [base :as & :refer [|do return fail |case]]
[lexer :as &lexer])))
;; [Utils]
@@ -17,7 +17,7 @@
token &lexer/lex]
(|case token
[meta (<close-tag> _)]
- (return (&/V <tag> (&/fold &/|++ &/Nil$ elems)))
+ (return (<tag> (&/fold &/|++ &/$Nil elems)))
_
(fail (str "[Parser Error] Unbalanced " <description> ".")))))
@@ -29,11 +29,11 @@
(defn ^:private parse-record [parse]
(|do [elems* (&/repeat% parse)
token &lexer/lex
- :let [elems (&/fold &/|++ &/Nil$ elems*)]]
+ :let [elems (&/fold &/|++ &/$Nil elems*)]]
(|case token
[meta (&lexer/$Close_Brace _)]
(if (even? (&/|length elems))
- (return (&/V &/$RecordS (&/|as-pairs elems)))
+ (return (&/$RecordS (&/|as-pairs elems)))
(fail (str "[Parser Error] Records must have an even number of elements.")))
_
@@ -45,31 +45,31 @@
:let [[meta token*] token]]
(|case token*
(&lexer/$White_Space _)
- (return &/Nil$)
+ (return &/$Nil)
(&lexer/$Comment _)
- (return &/Nil$)
+ (return &/$Nil)
(&lexer/$Bool ?value)
- (return (&/|list (&/T [meta (&/V &/$BoolS (Boolean/parseBoolean ?value))])))
+ (return (&/|list (&/T [meta (&/$BoolS (Boolean/parseBoolean ?value))])))
(&lexer/$Int ?value)
- (return (&/|list (&/T [meta (&/V &/$IntS (Long/parseLong ?value))])))
+ (return (&/|list (&/T [meta (&/$IntS (Long/parseLong ?value))])))
(&lexer/$Real ?value)
- (return (&/|list (&/T [meta (&/V &/$RealS (Double/parseDouble ?value))])))
+ (return (&/|list (&/T [meta (&/$RealS (Double/parseDouble ?value))])))
(&lexer/$Char ^String ?value)
- (return (&/|list (&/T [meta (&/V &/$CharS (.charAt ?value 0))])))
+ (return (&/|list (&/T [meta (&/$CharS (.charAt ?value 0))])))
(&lexer/$Text ?value)
- (return (&/|list (&/T [meta (&/V &/$TextS ?value)])))
+ (return (&/|list (&/T [meta (&/$TextS ?value)])))
(&lexer/$Symbol ?ident)
- (return (&/|list (&/T [meta (&/V &/$SymbolS ?ident)])))
+ (return (&/|list (&/T [meta (&/$SymbolS ?ident)])))
(&lexer/$Tag ?ident)
- (return (&/|list (&/T [meta (&/V &/$TagS ?ident)])))
+ (return (&/|list (&/T [meta (&/$TagS ?ident)])))
(&lexer/$Open_Paren _)
(|do [syntax (parse-form parse)]
diff --git a/src/lux/reader.clj b/src/lux/reader.clj
index 2ff8c4093..72d0ee11b 100644
--- a/src/lux/reader.clj
+++ b/src/lux/reader.clj
@@ -7,13 +7,13 @@
(:require [clojure.string :as string]
clojure.core.match
clojure.core.match.array
- [lux.base :as & :refer [deftags |do return* return fail fail* |let |case]]))
+ [lux.base :as & :refer [defvariant |do return* return fail fail* |let |case]]))
;; [Tags]
-(deftags
- ["No"
- "Done"
- "Yes"])
+(defvariant
+ ("No" 1)
+ ("Done" 1)
+ ("Yes" 2))
;; [Utils]
(defn ^:private with-line [body]
@@ -33,7 +33,7 @@
output)
($Yes output line*)
- (return* (&/set$ &/$source (&/Cons$ line* more) state)
+ (return* (&/set$ &/$source (&/$Cons line* more) state)
output))
)))
@@ -72,10 +72,10 @@
(let [match-length (.length match)
column-num* (+ column-num match-length)]
(if (= column-num* (.length line))
- (&/V $Done (&/T [(&/T [file-name line-num column-num]) true match]))
- (&/V $Yes (&/T [(&/T [(&/T [file-name line-num column-num]) false match])
- (&/T [(&/T [file-name line-num column-num*]) line])]))))
- (&/V $No (str "[Reader Error] Pattern failed: " regex))))))
+ ($Done (&/T [(&/T [file-name line-num column-num]) true match]))
+ ($Yes (&/T [(&/T [file-name line-num column-num]) false match])
+ (&/T [(&/T [file-name line-num column-num*]) line]))))
+ ($No (str "[Reader Error] Pattern failed: " regex))))))
(defn read-regex2 [regex]
(with-line
@@ -84,10 +84,10 @@
(let [match-length (.length match)
column-num* (+ column-num match-length)]
(if (= column-num* (.length line))
- (&/V $Done (&/T [(&/T [file-name line-num column-num]) true (&/T [tok1 tok2])]))
- (&/V $Yes (&/T [(&/T [(&/T [file-name line-num column-num]) false (&/T [tok1 tok2])])
- (&/T [(&/T [file-name line-num column-num*]) line])]))))
- (&/V $No (str "[Reader Error] Pattern failed: " regex))))))
+ ($Done (&/T [(&/T [file-name line-num column-num]) true (&/T [tok1 tok2])]))
+ ($Yes (&/T [(&/T [file-name line-num column-num]) false (&/T [tok1 tok2])])
+ (&/T [(&/T [file-name line-num column-num*]) line]))))
+ ($No (str "[Reader Error] Pattern failed: " regex))))))
(defn read-regex+ [regex]
(with-lines
@@ -96,7 +96,7 @@
reader* reader]
(|case reader*
(&/$Nil)
- (&/V &/$Left "[Reader Error] EOF")
+ (&/$Left "[Reader Error] EOF")
(&/$Cons [[file-name line-num column-num] ^String line]
reader**)
@@ -108,10 +108,10 @@
(str prefix match))]
(if (= column-num* (.length line))
(recur prefix* reader**)
- (&/V &/$Right (&/T [(&/Cons$ (&/T [(&/T [file-name line-num column-num*]) line])
- reader**)
- (&/T [(&/T [file-name line-num column-num]) prefix*])]))))
- (&/V &/$Left (str "[Reader Error] Pattern failed: " regex))))))))
+ (&/$Right (&/T [(&/$Cons (&/T [(&/T [file-name line-num column-num*]) line])
+ reader**)
+ (&/T [(&/T [file-name line-num column-num]) prefix*])]))))
+ (&/$Left (str "[Reader Error] Pattern failed: " regex))))))))
(defn read-text [^String text]
(with-line
@@ -120,10 +120,10 @@
(let [match-length (.length text)
column-num* (+ column-num match-length)]
(if (= column-num* (.length line))
- (&/V $Done (&/T [(&/T [file-name line-num column-num]) true text]))
- (&/V $Yes (&/T [(&/T [(&/T [file-name line-num column-num]) false text])
- (&/T [(&/T [file-name line-num column-num*]) line])]))))
- (&/V $No (str "[Reader Error] Text failed: " text))))))
+ ($Done (&/T [(&/T [file-name line-num column-num]) true text]))
+ ($Yes (&/T [(&/T [file-name line-num column-num]) false text])
+ (&/T [(&/T [file-name line-num column-num*]) line]))))
+ ($No (str "[Reader Error] Text failed: " text))))))
(defn from [^String name ^String source-code]
(let [lines (string/split-lines source-code)
@@ -132,6 +132,6 @@
line]))
lines
(range (count lines)))]
- (reduce (fn [tail head] (&/Cons$ head tail))
- &/Nil$
+ (reduce (fn [tail head] (&/$Cons head tail))
+ &/$Nil
(reverse indexed-lines))))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index d3a5f1493..9cb854c1e 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -25,143 +25,121 @@
_
false))
-(def empty-env &/Nil$)
-(defn Data$ [name params]
- (&/V &/$DataT (&/T [name params])))
-(defn Bound$ [idx]
- (&/V &/$BoundT idx))
-(defn Var$ [id]
- (&/V &/$VarT id))
-(defn Lambda$ [in out]
- (&/V &/$LambdaT (&/T [in out])))
-(defn App$ [fun arg]
- (&/V &/$AppT (&/T [fun arg])))
-(defn Prod$ [left right]
- (&/V &/$ProdT (&/T [left right])))
-(defn Sum$ [left right]
- (&/V &/$SumT (&/T [left right])))
-(defn Univ$ [env body]
- (&/V &/$UnivQ (&/T [env body])))
-(defn Ex$ [env body]
- (&/V &/$ExQ (&/T [env body])))
-(defn Named$ [name type]
- (&/V &/$NamedT (&/T [name type])))
-
-(def $Void (&/V &/$VoidT &/unit-tag))
-(def Unit (&/V &/$UnitT &/unit-tag))
-(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 Ident (Named$ (&/T ["lux" "Ident"]) (Prod$ Text Text)))
+(def empty-env &/$Nil)
+
+(def Bool (&/$NamedT (&/T ["lux" "Bool"]) (&/$DataT "java.lang.Boolean" &/$Nil)))
+(def Int (&/$NamedT (&/T ["lux" "Int"]) (&/$DataT "java.lang.Long" &/$Nil)))
+(def Real (&/$NamedT (&/T ["lux" "Real"]) (&/$DataT "java.lang.Double" &/$Nil)))
+(def Char (&/$NamedT (&/T ["lux" "Char"]) (&/$DataT "java.lang.Character" &/$Nil)))
+(def Text (&/$NamedT (&/T ["lux" "Text"]) (&/$DataT "java.lang.String" &/$Nil)))
+(def Ident (&/$NamedT (&/T ["lux" "Ident"]) (&/$ProdT Text Text)))
(def IO
- (Named$ (&/T ["lux/codata" "IO"])
- (Univ$ empty-env
- (Lambda$ $Void (Bound$ 1)))))
+ (&/$NamedT (&/T ["lux/codata" "IO"])
+ (&/$UnivQ empty-env
+ (&/$LambdaT &/$VoidT (&/$BoundT 1)))))
(def List
- (Named$ (&/T ["lux" "List"])
- (Univ$ empty-env
- (Sum$
- ;; lux;Nil
- Unit
- ;; lux;Cons
- (Prod$ (Bound$ 1)
- (App$ (Bound$ 0)
- (Bound$ 1)))))))
+ (&/$NamedT (&/T ["lux" "List"])
+ (&/$UnivQ empty-env
+ (&/$SumT
+ ;; lux;Nil
+ &/$UnitT
+ ;; lux;Cons
+ (&/$ProdT (&/$BoundT 1)
+ (&/$AppT (&/$BoundT 0)
+ (&/$BoundT 1)))))))
(def Maybe
- (Named$ (&/T ["lux" "Maybe"])
- (Univ$ empty-env
- (Sum$
- ;; lux;None
- Unit
- ;; lux;Some
- (Bound$ 1))
- )))
+ (&/$NamedT (&/T ["lux" "Maybe"])
+ (&/$UnivQ empty-env
+ (&/$SumT
+ ;; lux;None
+ &/$UnitT
+ ;; lux;Some
+ (&/$BoundT 1))
+ )))
(def Type
- (Named$ (&/T ["lux" "Type"])
- (let [Type (App$ (Bound$ 0) (Bound$ 1))
- TypeList (App$ List Type)
- TypePair (Prod$ Type Type)]
- (App$ (Univ$ empty-env
- (Sum$
- ;; DataT
- (Prod$ Text TypeList)
- (Sum$
- ;; VoidT
- Unit
- (Sum$
- ;; UnitT
- Unit
- (Sum$
- ;; SumT
- TypePair
- (Sum$
- ;; ProdT
- TypePair
- (Sum$
- ;; LambdaT
- TypePair
- (Sum$
- ;; BoundT
- Int
- (Sum$
- ;; VarT
- Int
- (Sum$
- ;; ExT
- Int
- (Sum$
- ;; UnivQ
- (Prod$ TypeList Type)
- (Sum$
- ;; ExQ
- (Prod$ TypeList Type)
- (Sum$
- ;; AppT
- TypePair
- ;; NamedT
- (Prod$ Ident Type)))))))))))))
- )
- $Void))))
+ (&/$NamedT (&/T ["lux" "Type"])
+ (let [Type (&/$AppT (&/$BoundT 0) (&/$BoundT 1))
+ TypeList (&/$AppT List Type)
+ TypePair (&/$ProdT Type Type)]
+ (&/$AppT (&/$UnivQ empty-env
+ (&/$SumT
+ ;; DataT
+ (&/$ProdT Text TypeList)
+ (&/$SumT
+ ;; VoidT
+ &/$UnitT
+ (&/$SumT
+ ;; UnitT
+ &/$UnitT
+ (&/$SumT
+ ;; SumT
+ TypePair
+ (&/$SumT
+ ;; ProdT
+ TypePair
+ (&/$SumT
+ ;; LambdaT
+ TypePair
+ (&/$SumT
+ ;; BoundT
+ Int
+ (&/$SumT
+ ;; VarT
+ Int
+ (&/$SumT
+ ;; ExT
+ Int
+ (&/$SumT
+ ;; UnivQ
+ (&/$ProdT TypeList Type)
+ (&/$SumT
+ ;; ExQ
+ (&/$ProdT TypeList Type)
+ (&/$SumT
+ ;; AppT
+ TypePair
+ ;; NamedT
+ (&/$ProdT Ident Type)))))))))))))
+ )
+ &/$VoidT))))
(def DefMetaValue
- (Named$ (&/T ["lux" "DefMetaValue"])
- (let [DefMetaValue (App$ (Bound$ 0) (Bound$ 1))]
- (App$ (Univ$ empty-env
- (Sum$
- ;; BoolM
- Bool
- (Sum$
- ;; IntM
- Int
- (Sum$
- ;; RealM
- Real
- (Sum$
- ;; CharM
- Char
- (Sum$
- ;; TextM
- Text
- (Sum$
- ;; IdentM
- Ident
- (Sum$
- ;; ListM
- (App$ List DefMetaValue)
- ;; DictM
- (App$ List (Prod$ Text DefMetaValue)))))))))
- )
- $Void))))
+ (&/$NamedT (&/T ["lux" "DefMetaValue"])
+ (let [DefMetaValue (&/$AppT (&/$BoundT 0) (&/$BoundT 1))]
+ (&/$AppT (&/$UnivQ empty-env
+ (&/$SumT
+ ;; BoolM
+ Bool
+ (&/$SumT
+ ;; IntM
+ Int
+ (&/$SumT
+ ;; RealM
+ Real
+ (&/$SumT
+ ;; CharM
+ Char
+ (&/$SumT
+ ;; TextM
+ Text
+ (&/$SumT
+ ;; IdentM
+ Ident
+ (&/$SumT
+ ;; ListM
+ (&/$AppT List DefMetaValue)
+ ;; DictM
+ (&/$AppT List (&/$ProdT Text DefMetaValue)))))))))
+ )
+ &/$VoidT))))
(def DefMeta
- (Named$ (&/T ["lux" "DefMeta"])
- (App$ List (Prod$ Ident DefMetaValue))))
+ (&/$NamedT (&/T ["lux" "DefMeta"])
+ (&/$AppT List (&/$ProdT Ident DefMetaValue))))
(def Macro)
@@ -208,7 +186,7 @@
(fail* (str "[Type Error] Can't rebind type var: " id " | Current type: " (show-type bound)))
(&/$None)
- (return* (&/update$ &/$type-vars (fn [ts] (&/update$ &/$mappings #(&/|put id (&/V &/$Some type) %)
+ (return* (&/update$ &/$type-vars (fn [ts] (&/update$ &/$mappings #(&/|put id (&/$Some type) %)
ts))
state)
nil))
@@ -221,14 +199,14 @@
(let [id (->> state (&/get$ &/$type-vars) (&/get$ &/$counter))]
(return* (&/update$ &/$type-vars #(->> %
(&/update$ &/$counter inc)
- (&/update$ &/$mappings (fn [ms] (&/|put id &/None$ ms))))
+ (&/update$ &/$mappings (fn [ms] (&/|put id &/$None ms))))
state)
id))))
(def existential
;; (Lux Type)
(|do [seed &/gen-id]
- (return (&/V &/$ExT seed))))
+ (return (&/$ExT seed))))
(declare clean*)
(defn ^:private delete-var [id]
@@ -250,12 +228,12 @@
(|case ?type*
(&/$VarT ?id*)
(if (.equals ^Object id ?id*)
- (return (&/T [?id &/None$]))
+ (return (&/T [?id &/$None]))
(return binding))
_
(|do [?type** (clean* id ?type*)]
- (return (&/T [?id (&/V &/$Some ?type**)]))))
+ (return (&/T [?id (&/$Some ?type**)]))))
))))
(->> state (&/get$ &/$type-vars) (&/get$ &/$mappings)))]
(fn [state]
@@ -266,7 +244,7 @@
(defn with-var [k]
(|do [id create-var
- output (k (Var$ id))
+ output (k (&/$VarT id))
_ (delete-var id)]
(return output)))
@@ -282,32 +260,32 @@
(&/$DataT ?name ?params)
(|do [=params (&/map% (partial clean* ?tid) ?params)]
- (return (Data$ ?name =params)))
+ (return (&/$DataT ?name =params)))
(&/$LambdaT ?arg ?return)
(|do [=arg (clean* ?tid ?arg)
=return (clean* ?tid ?return)]
- (return (Lambda$ =arg =return)))
+ (return (&/$LambdaT =arg =return)))
(&/$AppT ?lambda ?param)
(|do [=lambda (clean* ?tid ?lambda)
=param (clean* ?tid ?param)]
- (return (App$ =lambda =param)))
+ (return (&/$AppT =lambda =param)))
(&/$ProdT ?left ?right)
(|do [=left (clean* ?tid ?left)
=right (clean* ?tid ?right)]
- (return (Prod$ =left =right)))
+ (return (&/$ProdT =left =right)))
(&/$SumT ?left ?right)
(|do [=left (clean* ?tid ?left)
=right (clean* ?tid ?right)]
- (return (Sum$ =left =right)))
+ (return (&/$SumT =left =right)))
(&/$UnivQ ?env ?body)
(|do [=env (&/map% (partial clean* ?tid) ?env)
body* (clean* ?tid ?body)]
- (return (Univ$ =env body*)))
+ (return (&/$UnivQ =env body*)))
_
(return type)
@@ -325,10 +303,10 @@
(|case type
(&/$LambdaT ?in ?out)
(|let [[??out ?args] (unravel-fun ?out)]
- (&/T [??out (&/Cons$ ?in ?args)]))
+ (&/T [??out (&/$Cons ?in ?args)]))
_
- (&/T [type &/Nil$])))
+ (&/T [type &/$Nil])))
(defn ^:private unravel-app [fun-type]
(|case fun-type
@@ -337,14 +315,14 @@
(&/T [?fun-type (&/|++ ?args (&/|list ?right))]))
_
- (&/T [fun-type &/Nil$])))
+ (&/T [fun-type &/$Nil])))
(do-template [<tag> <flatten> <at> <desc>]
(do (defn <flatten> [type]
"(-> Type (List Type))"
(|case type
(<tag> left right)
- (&/Cons$ left (<flatten> right))
+ (&/$Cons left (<flatten> right))
_
(&/|list type)))
@@ -380,8 +358,8 @@
(&/$Nil)
<unit>))
- Variant$ Sum$ $Void
- Tuple$ Prod$ Unit
+ Variant$ &/$SumT &/$VoidT
+ Tuple$ &/$ProdT &/$UnitT
)
(defn show-type [^objects type]
@@ -495,17 +473,17 @@
(|let [[e a] k]
(|case fixpoints
(&/$Nil)
- &/None$
+ &/$None
(&/$Cons [[e* a*] v*] fixpoints*)
(if (and (type= e e*)
(type= a a*))
- (&/V &/$Some v*)
+ (&/$Some v*)
(fp-get k fixpoints*))
)))
(defn ^:private fp-put [k v fixpoints]
- (&/Cons$ (&/T [k v]) fixpoints))
+ (&/$Cons (&/T [k v]) fixpoints))
(defn show-type+ [type]
(|case type
@@ -533,31 +511,31 @@
(defn beta-reduce [env type]
(|case type
(&/$DataT ?name ?params)
- (Data$ ?name (&/|map (partial beta-reduce env) ?params))
+ (&/$DataT ?name (&/|map (partial beta-reduce env) ?params))
(&/$SumT ?left ?right)
(let [=left (beta-reduce env ?left)
=right (beta-reduce env ?right)]
- (Sum$ =left =right))
+ (&/$SumT =left =right))
(&/$ProdT ?left ?right)
(let [=left (beta-reduce env ?left)
=right (beta-reduce env ?right)]
- (Prod$ =left =right))
+ (&/$ProdT =left =right))
(&/$AppT ?type-fn ?type-arg)
- (App$ (beta-reduce env ?type-fn) (beta-reduce env ?type-arg))
+ (&/$AppT (beta-reduce env ?type-fn) (beta-reduce env ?type-arg))
(&/$UnivQ ?local-env ?local-def)
(|case ?local-env
(&/$Nil)
- (Univ$ env ?local-def)
+ (&/$UnivQ env ?local-def)
_
type)
(&/$LambdaT ?input ?output)
- (Lambda$ (beta-reduce env ?input) (beta-reduce env ?output))
+ (&/$LambdaT (beta-reduce env ?input) (beta-reduce env ?output))
(&/$BoundT ?idx)
(|case (&/|at ?idx env)
@@ -575,14 +553,14 @@
(|case type-fn
(&/$UnivQ local-env local-def)
(return (beta-reduce (->> local-env
- (&/Cons$ param)
- (&/Cons$ type-fn))
+ (&/$Cons param)
+ (&/$Cons type-fn))
local-def))
(&/$ExQ local-env local-def)
(return (beta-reduce (->> local-env
- (&/Cons$ param)
- (&/Cons$ type-fn))
+ (&/$Cons param)
+ (&/$Cons type-fn))
local-def))
(&/$AppT F A)
@@ -593,12 +571,12 @@
(apply-type ?type param)
(&/$ExT id)
- (return (App$ type-fn param))
+ (return (&/$AppT type-fn param))
_
(fail (str "[Type System] Not a type function:\n" (show-type type-fn) "\n"))))
-(def ^:private init-fixpoints &/Nil$)
+(def ^:private init-fixpoints &/$Nil)
(defn ^:private check* [class-loader fixpoints invariant?? expected actual]
(if (clojure.lang.Util/identical expected actual)
@@ -611,17 +589,17 @@
(|do [ebound (fn [state]
(|case ((deref ?eid) state)
(&/$Right state* ebound)
- (return* state* (&/V &/$Some ebound))
+ (return* state* (&/$Some ebound))
(&/$Left _)
- (return* state &/None$)))
+ (return* state &/$None)))
abound (fn [state]
(|case ((deref ?aid) state)
(&/$Right state* abound)
- (return* state* (&/V &/$Some abound))
+ (return* state* (&/$Some abound))
(&/$Left _)
- (return* state &/None$)))]
+ (return* state &/$None)))]
(|case [ebound abound]
[(&/$None _) (&/$None _)]
(|do [_ (set-var ?eid actual)]
@@ -666,13 +644,13 @@
[(&/$AppT (&/$VarT ?id) A1) (&/$AppT F2 A2)]
(fn [state]
(|case ((|do [F1 (deref ?id)]
- (check* class-loader fixpoints invariant?? (App$ F1 A1) actual))
+ (check* class-loader fixpoints invariant?? (&/$AppT F1 A1) actual))
state)
(&/$Right state* output)
(return* state* output)
(&/$Left _)
- ((|do [[fixpoints* _] (check* class-loader fixpoints invariant?? (Var$ ?id) F2)
+ ((|do [[fixpoints* _] (check* class-loader fixpoints invariant?? (&/$VarT ?id) F2)
e* (apply-type F2 A1)
a* (apply-type F2 A2)
[fixpoints** _] (check* class-loader fixpoints* invariant?? e* a*)]
@@ -682,13 +660,13 @@
[(&/$AppT F1 A1) (&/$AppT (&/$VarT ?id) A2)]
(fn [state]
(|case ((|do [F2 (deref ?id)]
- (check* class-loader fixpoints invariant?? expected (App$ F2 A2)))
+ (check* class-loader fixpoints invariant?? expected (&/$AppT F2 A2)))
state)
(&/$Right state* output)
(return* state* output)
(&/$Left _)
- ((|do [[fixpoints* _] (check* class-loader fixpoints invariant?? F1 (Var$ ?id))
+ ((|do [[fixpoints* _] (check* class-loader fixpoints invariant?? F1 (&/$VarT ?id))
e* (apply-type F1 A1)
a* (apply-type F1 A2)
[fixpoints** _] (check* class-loader fixpoints* invariant?? e* a*)]
@@ -724,7 +702,7 @@
(|do [$arg existential
expected* (apply-type expected $arg)]
(check* class-loader fixpoints invariant?? expected* actual))
-
+
[_ (&/$UnivQ _)]
(with-var
(fn [$arg]
@@ -735,16 +713,16 @@
(with-var
(fn [$arg]
(|let [expected* (beta-reduce (->> e!env
- (&/Cons$ $arg)
- (&/Cons$ expected))
+ (&/$Cons $arg)
+ (&/$Cons expected))
e!def)]
(check* class-loader fixpoints invariant?? expected* actual))))
[_ (&/$ExQ a!env a!def)]
(|do [$arg existential]
(|let [actual* (beta-reduce (->> a!env
- (&/Cons$ $arg)
- (&/Cons$ expected))
+ (&/$Cons $arg)
+ (&/$Cons expected))
a!def)]
(check* class-loader fixpoints invariant?? expected actual*)))
@@ -852,12 +830,12 @@
(|let [?member-types (flatten-prod type)
size-types (&/|length ?member-types)]
(if (not (>= size-types size-members))
- &/None$
+ &/$None
(|let [?member-types* (if (= size-types size-members)
?member-types
(&/|++ (&/|take (dec size-members) ?member-types)
(&/|list (|case (->> (&/|drop (dec size-members) ?member-types) (&/|reverse))
(&/$Cons last prevs)
- (&/fold (fn [right left] (Prod$ left right))
+ (&/fold (fn [right left] (&/$ProdT left right))
last prevs)))))]
- (&/Some$ ?member-types*)))))
+ (&/$Some ?member-types*)))))
diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj
index ae225db1f..531169538 100644
--- a/src/lux/type/host.clj
+++ b/src/lux/type/host.clj
@@ -29,26 +29,26 @@
stack (&/|list)]
(let [super-interface (some valid-sub? (.getInterfaces sub-class))]
(if (= super-class super-interface)
- (&/Cons$ super-interface stack)
- (recur super-interface (&/Cons$ super-interface stack)))))
+ (&/$Cons super-interface stack)
+ (recur super-interface (&/$Cons super-interface stack)))))
(.isInterface super-class)
(loop [sub-class sub-class
stack (&/|list)]
(if-let [super-interface (some valid-sub? (.getInterfaces sub-class))]
(if (= super-class super-interface)
- (&/Cons$ super-interface stack)
- (recur super-interface (&/Cons$ super-interface stack)))
+ (&/$Cons super-interface stack)
+ (recur super-interface (&/$Cons super-interface stack)))
(let [super* (.getSuperclass sub-class)]
- (recur super* (&/Cons$ super* stack)))))
+ (recur super* (&/$Cons super* stack)))))
:else
(loop [sub-class sub-class
stack (&/|list)]
(let [super* (.getSuperclass sub-class)]
(if (= super* super-class)
- (&/Cons$ super* stack)
- (recur super* (&/Cons$ super* stack))))))))
+ (&/$Cons super* stack)
+ (recur super* (&/$Cons super* stack))))))))
(defn ^:private trace-lineage [^Class sub-class ^Class super-class]
"(-> Class Class (List Class))"
@@ -56,7 +56,7 @@
(&/|list)
(&/|reverse (trace-lineage* super-class sub-class))))
-(let [matcher (fn [m ^TypeVariable jt lt] (&/Cons$ (&/T [(.getName jt) lt]) m))]
+(let [matcher (fn [m ^TypeVariable jt lt] (&/$Cons (&/T [(.getName jt) lt]) m))]
(defn ^:private match-params [sub-type-params params]
(assert (and (= (&/|length sub-type-params) (&/|length params))
(&/|every? (partial instance? TypeVariable) sub-type-params)))
@@ -64,7 +64,6 @@
;; [Exports]
(let [class-name-re #"((\[+)L([\.a-zA-Z0-9]+);|([\.a-zA-Z0-9]+)|(\[+)([ZBSIJFDC]))"
- Unit (&/V &/$UnitT &/unit-tag)
jprim->lprim (fn [prim]
(case prim
"Z" "boolean"
@@ -80,9 +79,9 @@
(if-let [[_ _ arr-obrackets arr-obase simple-base arr-pbrackets arr-pbase] (re-find class-name-re (.getName class))]
(let [base (or arr-obase simple-base (jprim->lprim arr-pbase))]
(if (.equals "void" base)
- Unit
- (reduce (fn [inner _] (&/V &/$DataT (&/T [array-data-tag (&/|list inner)])))
- (&/V &/$DataT (&/T [base &/Nil$]))
+ &/$UnitT
+ (reduce (fn [inner _] (&/$DataT array-data-tag (&/|list inner)))
+ (&/$DataT base &/$Nil)
(range (count (or arr-obrackets arr-pbrackets "")))))
))))
@@ -93,7 +92,7 @@
(instance? GenericArrayType refl-type)
(|do [inner-type (instance-param existential matchings (.getGenericComponentType ^GenericArrayType refl-type))]
- (return (&/V &/$DataT (&/T [array-data-tag (&/|list inner-type)]))))
+ (return (&/$DataT array-data-tag (&/|list inner-type))))
(instance? ParameterizedType refl-type)
(|do [:let [refl-type* ^ParameterizedType refl-type]
@@ -101,8 +100,8 @@
.getActualTypeArguments
seq &/->list
(&/map% (partial instance-param existential matchings)))]
- (return (&/V &/$DataT (&/T [(->> refl-type* ^Class (.getRawType) .getName)
- params*]))))
+ (return (&/$DataT (->> refl-type* ^Class (.getRawType) .getName)
+ params*)))
(instance? TypeVariable refl-type)
(let [gvar (.getName ^TypeVariable refl-type)]
@@ -123,15 +122,14 @@
(|case gtype
(&/$GenericArray component-type)
(|do [inner-type (instance-gtype existential matchings component-type)]
- (return (&/V &/$DataT (&/T [array-data-tag (&/|list inner-type)]))))
+ (return (&/$DataT array-data-tag (&/|list inner-type))))
(&/$GenericClass type-name type-params)
(if-let [m-type (&/|get type-name matchings)]
(return m-type)
(|do [params* (&/map% (partial instance-gtype existential matchings)
type-params)]
- (return (&/V &/$DataT (&/T [type-name
- params*])))))
+ (return (&/$DataT type-name params*))))
(&/$GenericTypeVar var-name)
(if-let [m-type (&/|get var-name matchings)]
@@ -191,7 +189,7 @@
(if (.isAssignableFrom super-class+ sub-class+)
(let [lineage (trace-lineage sub-class+ super-class+)]
(|do [[^Class sub-class* sub-params*] (raise existential lineage sub-class+ sub-params)]
- (return (&/V &/$DataT (&/T [(.getName sub-class*) sub-params*])))))
+ (return (&/$DataT (.getName sub-class*) sub-params*))))
(fail (str "[Type Error] Classes don't have a subtyping relationship: " sub-class " </= " super-class)))))
(defn as-obj [class]
@@ -220,16 +218,16 @@
(= null-data-tag a!name)
(if (not (primitive-type? e!name))
(return (&/T [fixpoints nil]))
- (check-error "" (&/V &/$DataT expected) (&/V &/$DataT actual)))
+ (check-error "" (&/$DataT e!name e!params) (&/$DataT a!name a!params)))
(= null-data-tag e!name)
(if (= null-data-tag a!name)
(return (&/T [fixpoints nil]))
- (check-error "" (&/V &/$DataT expected) (&/V &/$DataT actual)))
+ (check-error "" (&/$DataT e!name e!params) (&/$DataT a!name a!params)))
(and (= array-data-tag e!name)
(not= array-data-tag a!name))
- (check-error "" (&/V &/$DataT expected) (&/V &/$DataT actual))
+ (check-error "" (&/$DataT e!name e!params) (&/$DataT a!name a!params))
:else
(let [e!name (as-obj e!name)
@@ -242,7 +240,7 @@
(not invariant??)
(|do [actual* (->super-type existential class-loader e!name a!name a!params)]
- (check (&/V &/$DataT expected) actual*))
+ (check (&/$DataT e!name e!params) actual*))
:else
(fail (str "[Type Error] Names don't match: " e!name " =/= " a!name)))))
@@ -253,10 +251,10 @@
(defn gtype->gclass [gtype]
"(-> GenericType GenericClass)"
(cond (instance? Class gtype)
- (&/V &/$GenericClass (&/T [(.getName ^Class gtype) &/Nil$]))
+ (&/$GenericClass (.getName ^Class gtype) &/$Nil)
(instance? GenericArrayType gtype)
- (&/V &/$GenericArray (gtype->gclass (.getGenericComponentType ^GenericArrayType gtype)))
+ (&/$GenericArray (gtype->gclass (.getGenericComponentType ^GenericArrayType gtype)))
(instance? ParameterizedType gtype)
(let [type-name (->> ^ParameterizedType gtype ^Class (.getRawType) .getName)
@@ -264,12 +262,12 @@
.getActualTypeArguments
seq &/->list
(&/|map gtype->gclass))]
- (&/V &/$GenericClass (&/T [type-name type-params])))
+ (&/$GenericClass type-name type-params))
(instance? TypeVariable gtype)
- (&/V &/$GenericTypeVar (.getName ^TypeVariable gtype))
+ (&/$GenericTypeVar (.getName ^TypeVariable gtype))
(instance? WildcardType gtype)
(if-let [bound (->> ^WildcardType gtype .getUpperBounds seq first)]
(gtype->gclass bound)
- (&/V &/$GenericWildcard &/unit-tag))))
+ &/$GenericWildcard)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 01:17:12 +0000