aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorEduardo Julian2016-01-05 22:22:54 -0400
committerEduardo Julian2016-01-05 22:22:54 -0400
commit3855f395e7cdd8e49086f2d0d82ed231e8896b69 (patch)
tree173c7b9f3aa5c8f86a44210074634da11b5b9a40 /src
parentc52036b75a692a0def3fedb7f175134d8dfb0f5b (diff)
- Optimized the new "product" implementation to improve performance & memory consumption.
Diffstat (limited to '')
-rw-r--r--src/lux/analyser.clj4
-rw-r--r--src/lux/analyser/base.clj6
-rw-r--r--src/lux/analyser/case.clj92
-rw-r--r--src/lux/analyser/host.clj114
-rw-r--r--src/lux/analyser/lambda.clj16
-rw-r--r--src/lux/analyser/lux.clj30
-rw-r--r--src/lux/analyser/meta.clj8
-rw-r--r--src/lux/analyser/module.clj48
-rw-r--r--src/lux/analyser/parser.clj34
-rw-r--r--src/lux/analyser/record.clj8
-rw-r--r--src/lux/base.clj186
-rw-r--r--src/lux/compiler/cache.clj4
-rw-r--r--src/lux/compiler/case.clj16
-rw-r--r--src/lux/compiler/host.clj26
-rw-r--r--src/lux/compiler/lux.clj42
-rw-r--r--src/lux/compiler/module.clj8
-rw-r--r--src/lux/compiler/type.clj2
-rw-r--r--src/lux/host.clj22
-rw-r--r--src/lux/host/generics.clj2
-rw-r--r--src/lux/lexer.clj32
-rw-r--r--src/lux/parser.clj20
-rw-r--r--src/lux/reader.clj28
-rw-r--r--src/lux/type.clj80
-rw-r--r--src/lux/type/host.clj40
24 files changed, 428 insertions, 440 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 71044b923..f143e2a12 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -95,7 +95,7 @@
(&&host/analyse-jvm-laload analyse exo-type ?array ?idx)
_
- (fail-with-loc (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T (&/T "" -1 -1) token)))))))
+ (fail-with-loc (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T [(&/T ["" -1 -1]) token])))))))
(defn ^:private aba9 [analyse eval! compile-module compile-token exo-type token]
(|case token
@@ -390,7 +390,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")]
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index bbbe18a89..5149456aa 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -176,14 +176,14 @@
(|do [=expr (analyse-1 analyse $var ?token)
:let [[[?type ?cursor] ?item] =expr]
=type (&type/clean $var ?type)]
- (return (&/T (&/T =type ?cursor) ?item))))))
+ (return (&/T [(&/T [=type ?cursor]) ?item]))))))
(defn resolved-ident [ident]
(|do [:let [[?module ?name] ident]
module* (if (.equals "" ?module)
&/get-module-name
(return ?module))]
- (return (&/T module* ?name))))
+ (return (&/T [module* ?name]))))
(let [tag-names #{"DataT" "VoidT" "UnitT" "SumT" "ProdT" "LambdaT" "BoundT" "VarT" "ExT" "UnivQ" "ExQ" "AppT" "NamedT"}]
(defn type-tag? [module name]
@@ -191,4 +191,4 @@
(contains? tag-names name))))
(defn |meta [type cursor analysis]
- (&/T (&/T type cursor) analysis))
+ (&/T [(&/T [type cursor]) analysis]))
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 517a58ab7..85d4dbb1a 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -39,7 +39,7 @@
;; [Utils]
(def ^:private unit
- (&/T (&/T "" -1 -1) (&/V &/$TupleS &/Nil$)))
+ (&/T [(&/T ["" -1 -1]) (&/V &/$TupleS &/Nil$)]))
(defn ^:private resolve-type [type]
(|case type
@@ -58,7 +58,7 @@
(defn update-up-frame [frame]
(|let [[_env _idx _var] frame]
- (&/T _env (+ 2 _idx) _var)))
+ (&/T [_env (+ 2 _idx) _var])))
(defn adjust-type* [up type]
"(-> (List (, (Maybe (List Type)) Int Type)) Type (Lux Type))"
@@ -67,7 +67,7 @@
(&type/with-var
(fn [$var]
(|do [=type (&type/apply-type type $var)]
- (adjust-type* (&/Cons$ (&/T _aenv 1 $var) (&/|map update-up-frame up)) =type))))
+ (adjust-type* (&/Cons$ (&/T [_aenv 1 $var]) (&/|map update-up-frame up)) =type))))
(&/$ExQ _aenv _abody)
(|do [$var &type/existential
@@ -84,7 +84,7 @@
:let [distributor (fn [v]
(&/fold (fn [_abody ena]
(|let [[_aenv _aidx _avar] ena]
- (&/V &/$UnivQ (&/T _aenv _abody))))
+ (&/V &/$UnivQ (&/T [_aenv _abody]))))
v
up))]]
(return (&type/Prod$ (distributor =left) (distributor =right))))
@@ -99,7 +99,7 @@
:let [distributor (fn [v]
(&/fold (fn [_abody ena]
(|let [[_aenv _aidx _avar] ena]
- (&/V &/$UnivQ (&/T _aenv _abody))))
+ (&/V &/$UnivQ (&/T [_aenv _abody]))))
v
up))]]
(return (&type/Sum$ (distributor =left) (distributor =right))))
@@ -135,13 +135,13 @@
(&/$Some var-analysis)
(|do [=kont (&env/with-alias name var-analysis
kont)]
- (return (&/T (&/V $StoreTestAC -1) =kont)))
+ (return (&/T [(&/V $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 [(&/V $StoreTestAC idx) =kont]))))
(&/$SymbolS ident)
(fail (str "[Pattern-matching Error] Symbols must be unqualified: " (&/ident->text ident)))
@@ -149,34 +149,34 @@
(&/$BoolS ?value)
(|do [_ (&type/check value-type &type/Bool)
=kont kont]
- (return (&/T (&/V $BoolTestAC ?value) =kont)))
+ (return (&/T [(&/V $BoolTestAC ?value) =kont])))
(&/$IntS ?value)
(|do [_ (&type/check value-type &type/Int)
=kont kont]
- (return (&/T (&/V $IntTestAC ?value) =kont)))
+ (return (&/T [(&/V $IntTestAC ?value) =kont])))
(&/$RealS ?value)
(|do [_ (&type/check value-type &type/Real)
=kont kont]
- (return (&/T (&/V $RealTestAC ?value) =kont)))
+ (return (&/T [(&/V $RealTestAC ?value) =kont])))
(&/$CharS ?value)
(|do [_ (&type/check value-type &type/Char)
=kont kont]
- (return (&/T (&/V $CharTestAC ?value) =kont)))
+ (return (&/T [(&/V $CharTestAC ?value) =kont])))
(&/$TextS ?value)
(|do [_ (&type/check value-type &type/Text)
=kont kont]
- (return (&/T (&/V $TextTestAC ?value) =kont)))
+ (return (&/T [(&/V $TextTestAC ?value) =kont])))
(&/$TupleS ?members)
(|case ?members
(&/$Nil)
(|do [_ (&type/check value-type &type/Unit)
=kont kont]
- (return (&/T (&/V $TupleTestAC (&/|list)) =kont)))
+ (return (&/T [(&/V $TupleTestAC (&/|list)) =kont])))
(&/$Cons ?member (&/$Nil))
(analyse-pattern var?? value-type ?member kont)
@@ -193,18 +193,18 @@
(|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)))))
+ (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 [(&/V $TupleTestAC =tests) =kont]))))
_
(fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type))))))
(&/$RecordS pairs)
(|do [[rec-members rec-type] (&&record/order-record pairs)]
- (analyse-pattern &/None$ value-type (&/T meta (&/V &/$TupleS rec-members)) kont))
+ (analyse-pattern &/None$ value-type (&/T [meta (&/V &/$TupleS rec-members)]) kont))
(&/$TagS ?ident)
(|do [[=module =name] (&&/resolved-ident ?ident)
@@ -213,7 +213,7 @@
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)))
+ (return (&/T [(&/V $VariantTestAC (&/T [idx (&/|length group) =test])) =kont])))
(&/$FormS (&/$Cons [_ (&/$TagS ?ident)]
?values))
@@ -226,8 +226,8 @@
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]) (&/V &/$TupleS ?values)]) kont))]
+ (return (&/T [(&/V $VariantTestAC (&/T [idx (&/|length group) =test])) =kont])))
_
(fail (str "[Pattern-matching Error] Unrecognized pattern syntax: " (&/show-ast pattern)))
@@ -245,80 +245,80 @@
(return (&/V $DefaultTotal true))
[($BoolTotal total? ?values) ($StoreTestAC ?idx)]
- (return (&/V $BoolTotal (&/T true ?values)))
+ (return (&/V $BoolTotal (&/T [true ?values])))
[($IntTotal total? ?values) ($StoreTestAC ?idx)]
- (return (&/V $IntTotal (&/T true ?values)))
+ (return (&/V $IntTotal (&/T [true ?values])))
[($RealTotal total? ?values) ($StoreTestAC ?idx)]
- (return (&/V $RealTotal (&/T true ?values)))
+ (return (&/V $RealTotal (&/T [true ?values])))
[($CharTotal total? ?values) ($StoreTestAC ?idx)]
- (return (&/V $CharTotal (&/T true ?values)))
+ (return (&/V $CharTotal (&/T [true ?values])))
[($TextTotal total? ?values) ($StoreTestAC ?idx)]
- (return (&/V $TextTotal (&/T true ?values)))
+ (return (&/V $TextTotal (&/T [true ?values])))
[($TupleTotal total? ?values) ($StoreTestAC ?idx)]
- (return (&/V $TupleTotal (&/T true ?values)))
+ (return (&/V $TupleTotal (&/T [true ?values])))
[($VariantTotal total? ?values) ($StoreTestAC ?idx)]
- (return (&/V $VariantTotal (&/T true ?values)))
+ (return (&/V $VariantTotal (&/T [true ?values])))
[($DefaultTotal total?) ($BoolTestAC ?value)]
- (return (&/V $BoolTotal (&/T total? (&/|list ?value))))
+ (return (&/V $BoolTotal (&/T [total? (&/|list ?value)])))
[($BoolTotal total? ?values) ($BoolTestAC ?value)]
- (return (&/V $BoolTotal (&/T total? (&/Cons$ ?value ?values))))
+ (return (&/V $BoolTotal (&/T [total? (&/Cons$ ?value ?values)])))
[($DefaultTotal total?) ($IntTestAC ?value)]
- (return (&/V $IntTotal (&/T total? (&/|list ?value))))
+ (return (&/V $IntTotal (&/T [total? (&/|list ?value)])))
[($IntTotal total? ?values) ($IntTestAC ?value)]
- (return (&/V $IntTotal (&/T total? (&/Cons$ ?value ?values))))
+ (return (&/V $IntTotal (&/T [total? (&/Cons$ ?value ?values)])))
[($DefaultTotal total?) ($RealTestAC ?value)]
- (return (&/V $RealTotal (&/T total? (&/|list ?value))))
+ (return (&/V $RealTotal (&/T [total? (&/|list ?value)])))
[($RealTotal total? ?values) ($RealTestAC ?value)]
- (return (&/V $RealTotal (&/T total? (&/Cons$ ?value ?values))))
+ (return (&/V $RealTotal (&/T [total? (&/Cons$ ?value ?values)])))
[($DefaultTotal total?) ($CharTestAC ?value)]
- (return (&/V $CharTotal (&/T total? (&/|list ?value))))
+ (return (&/V $CharTotal (&/T [total? (&/|list ?value)])))
[($CharTotal total? ?values) ($CharTestAC ?value)]
- (return (&/V $CharTotal (&/T total? (&/Cons$ ?value ?values))))
+ (return (&/V $CharTotal (&/T [total? (&/Cons$ ?value ?values)])))
[($DefaultTotal total?) ($TextTestAC ?value)]
- (return (&/V $TextTotal (&/T total? (&/|list ?value))))
+ (return (&/V $TextTotal (&/T [total? (&/|list ?value)])))
[($TextTotal total? ?values) ($TextTestAC ?value)]
- (return (&/V $TextTotal (&/T total? (&/Cons$ ?value ?values))))
+ (return (&/V $TextTotal (&/T [total? (&/Cons$ ?value ?values)])))
[($DefaultTotal total?) ($TupleTestAC ?tests)]
(|do [structs (&/map% (fn [t]
- (merge-total (&/V $DefaultTotal total?) (&/T t ?body)))
+ (merge-total (&/V $DefaultTotal total?) (&/T [t ?body])))
?tests)]
- (return (&/V $TupleTotal (&/T total? structs))))
+ (return (&/V $TupleTotal (&/T [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)))
+ (merge-total v (&/T [t ?body])))
?values ?tests)]
- (return (&/V $TupleTotal (&/T total? structs))))
+ (return (&/V $TupleTotal (&/T [total? structs]))))
(fail "[Pattern-matching Error] Inconsistent tuple-size."))
[($DefaultTotal total?) ($VariantTestAC ?tag ?count ?test)]
(|do [sub-struct (merge-total (&/V $DefaultTotal total?)
- (&/T ?test ?body))
+ (&/T [?test ?body]))
structs (|case (&/|list-put ?tag sub-struct (&/|repeat ?count (&/V $DefaultTotal total?)))
(&/$Some list)
(return list)
(&/$None)
(fail "[Pattern-matching Error] YOLO"))]
- (return (&/V $VariantTotal (&/T total? structs))))
+ (return (&/V $VariantTotal (&/T [total? structs]))))
[($VariantTotal total? ?branches) ($VariantTestAC ?tag ?count ?test)]
(|do [sub-struct (merge-total (|case (&/|at ?tag ?branches)
@@ -327,14 +327,14 @@
(&/$None)
(&/V $DefaultTotal total?))
- (&/T ?test ?body))
+ (&/T [?test ?body]))
structs (|case (&/|list-put ?tag sub-struct ?branches)
(&/$Some list)
(return list)
(&/$None)
(fail "[Pattern-matching Error] YOLO"))]
- (return (&/V $VariantTotal (&/T total? structs))))
+ (return (&/V $VariantTotal (&/T [total? structs]))))
)))
(defn check-totality+ [check-totality]
@@ -344,7 +344,7 @@
(|do [=output (check-totality $var ?token)
?type (&type/deref+ $var)
=type (&type/clean $var ?type)]
- (return (&/T =output =type)))))))
+ (return (&/T [=output =type])))))))
(defn ^:private check-totality [value-type struct]
(|case struct
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 25f7852dc..86e73723d 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -51,8 +51,8 @@
(&/V &/$Left msg)
(&/$Right state** output)
- (&/V &/$Right (&/T (->> state** (&/update$ &/$host #(&/set$ &/$catching old-catches %)))
- output))))
+ (&/V &/$Right (&/T [(->> state** (&/update$ &/$host #(&/set$ &/$catching old-catches %)))
+ output]))))
))
(defn ^:private ensure-object [type]
@@ -114,15 +114,15 @@
(|do [? (&type/bound? id)]
(if ?
(|do [real-type (&type/deref id)]
- (return (&/T idx real-type)))
- (return (&/T (+ 2 idx) (&type/Bound$ idx)))))))
+ (return (&/T [idx real-type])))
+ (return (&/T [(+ 2 idx) (&type/Bound$ 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 (&/|list)])
gtype-vars)]
(return clean-types)))
@@ -148,7 +148,7 @@
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta output-type _cursor
- (&/V <output-tag> (&/T =x =y))))))))
+ (&/V <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)]
@@ -214,7 +214,7 @@
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-getstatic (&/T class field output-type)))))))
+ (&/V &&/$jvm-getstatic (&/T [class field output-type])))))))
(defn analyse-jvm-getfield [analyse exo-type class field object]
(|do [class-loader &/loader
@@ -226,7 +226,7 @@
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-getfield (&/T class field =object output-type)))))))
+ (&/V &&/$jvm-getfield (&/T [class field =object output-type])))))))
(defn analyse-jvm-putstatic [analyse exo-type class field value]
(|do [class-loader &/loader
@@ -238,7 +238,7 @@
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-putstatic (&/T class field =value gclass =type)))))))
+ (&/V &&/$jvm-putstatic (&/T [class field =value gclass =type])))))))
(defn analyse-jvm-putfield [analyse exo-type class field value object]
(|do [class-loader &/loader
@@ -253,7 +253,7 @@
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-putfield (&/T class field =value gclass =object =type)))))))
+ (&/V &&/$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)))))))
+ (&/V &&/$jvm-instanceof (&/T [class =object])))))))
(defn ^:private analyse-method-call-helper [analyse gret gtype-env gtype-vars gtype-args args]
(|case gtype-vars
@@ -270,12 +270,12 @@
(|do [arg-types (&/map% (partial &host-type/instance-param &type/existential gtype-env) gtype-args)
=args (&/map2% (partial &&/analyse-1 analyse) arg-types args)
=gret (&host-type/instance-param &type/existential gtype-env gret)]
- (return (&/T =gret =args)))
+ (return (&/T [=gret =args])))
(&/$Cons ^TypeVariable gtv gtype-vars*)
(&type/with-var
(fn [$var]
- (|let [gtype-env* (&/Cons$ (&/T (.getName gtv) $var) gtype-env)]
+ (|let [gtype-env* (&/Cons$ (&/T [(.getName gtv) $var]) gtype-env)]
(analyse-method-call-helper analyse gret gtype-env* gtype-vars* gtype-args args))))
))
@@ -291,13 +291,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*)]
@@ -305,7 +305,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)))))))
+ (&/V <tag> (&/T [class method classes =object =args output-type])))))))
analyse-jvm-invokevirtual &&/$jvm-invokevirtual false
analyse-jvm-invokespecial &&/$jvm-invokespecial false
@@ -318,14 +318,14 @@
_ (ensure-catching exceptions)
gtype-env (&/fold% (fn [m ^TypeVariable g]
(|do [=var-type &type/existential]
- (return (&/Cons$ (&/T (.getName g) =var-type) m))))
+ (return (&/Cons$ (&/T [(.getName g) =var-type]) m))))
(&/|table)
parent-gvars)
[output-type =args] (analyse-method-call-helper analyse gret gtype-env gvars gargs args)
_ (&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)))))))
+ (&/V &&/$jvm-invokestatic (&/T [class method classes =args output-type])))))))
(defn analyse-jvm-null? [analyse exo-type object]
(|do [=object (&&/analyse-1+ analyse object)
@@ -349,13 +349,13 @@
(|do [arg-types (&/map% (partial &host-type/instance-param &type/existential gtype-env) gtype-args)
=args (&/map2% (partial &&/analyse-1 analyse) arg-types args)
gtype-vars* (->> gtype-env (&/|map &/|second) (clean-gtype-vars))]
- (return (&/T (make-gtype gtype gtype-vars*)
- =args)))
+ (return (&/T [(make-gtype gtype gtype-vars*)
+ =args])))
(&/$Cons ^TypeVariable gtv gtype-vars*)
(&type/with-var
(fn [$var]
- (|let [gtype-env* (&/Cons$ (&/T (.getName gtv) $var) gtype-env)]
+ (|let [gtype-env* (&/Cons$ (&/T [(.getName gtv) $var]) gtype-env)]
(analyse-jvm-new-helper analyse gtype gtype-env* gtype-vars* gtype-args args))))
))
@@ -367,7 +367,7 @@
_ (&type/check exo-type output-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-new (&/T class classes =args)))))))
+ (&/V &&/$jvm-new (&/T [class classes =args])))))))
(let [length-type &type/Int
idx-type &type/Int]
@@ -387,7 +387,7 @@
_ (&type/check exo-type elem-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V <load-tag> (&/T =array =idx)))))))
+ (&/V <load-tag> (&/T [=array =idx])))))))
(defn <store-name> [analyse exo-type array idx elem]
(|do [=array (&&/analyse-1 analyse array-type array)
@@ -396,7 +396,7 @@
_ (&type/check exo-type array-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V <store-tag> (&/T =array =idx =elem)))))))
+ (&/V <store-tag> (&/T [=array =idx =elem])))))))
)
"java.lang.Boolean" analyse-jvm-znewarray &&/$jvm-znewarray analyse-jvm-zaload &&/$jvm-zaload analyse-jvm-zastore &&/$jvm-zastore
@@ -419,7 +419,7 @@
_ (&type/check exo-type array-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-anewarray (&/T gclass =length gtype-env)))))))
+ (&/V &&/$jvm-anewarray (&/T [gclass =length gtype-env])))))))
(defn analyse-jvm-aaload [analyse exo-type array idx]
(|do [=array (&&/analyse-1+ analyse array)
@@ -430,7 +430,7 @@
_ (&type/check exo-type inner-arr-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-aaload (&/T =array =idx)))))))
+ (&/V &&/$jvm-aaload (&/T [=array =idx])))))))
(defn analyse-jvm-aastore [analyse exo-type array idx elem]
(|do [=array (&&/analyse-1+ analyse array)
@@ -443,7 +443,7 @@
_ (&type/check exo-type array-type)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-aastore (&/T =array =idx =elem))))))))
+ (&/V &&/$jvm-aastore (&/T [=array =idx =elem]))))))))
(defn analyse-jvm-arraylength [analyse exo-type array]
(|do [=array (&&/analyse-1+ analyse array)
@@ -553,19 +553,19 @@
(&/map% (fn [var+gtype]
(|do [:let [[var gtype] var+gtype]
=gtype (generic-class->type class-env gtype)]
- (return (&/T var =gtype))))
+ (return (&/T [var =gtype]))))
vars+gtypes)
)))
(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 (&/V &/$DataT (&/T [?cname (&/|map &/|second class-env)]))]
(|case method
(&/$ConstructorMethodSyntax ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body)
(|do [method-env (&/map% (fn [gvar]
(|do [ex &type/existential]
- (return (&/T gvar ex))))
+ (return (&/T [gvar ex]))))
?gvars)
:let [full-env (&/|++ class-env method-env)]
:let [output-type &type/Unit]
@@ -573,7 +573,7 @@
(|do [:let [[ca-type ca-term] ctor-arg]
=ca-type (generic-class->type full-env ca-type)
=ca-term (&&/analyse-1 analyse =ca-type ca-term)]
- (return (&/T ca-type =ca-term))))
+ (return (&/T [ca-type =ca-term]))))
?ctor-args)
=body (&/with-type-env full-env
(&&env/with-local &&/jvm-this class-type
@@ -584,12 +584,12 @@
body*)))
(&&/analyse-1 analyse output-type ?body)
(&/|reverse ?inputs))))]
- (return (&/V &/$ConstructorMethodAnalysis (&/T ?anns ?gvars ?exceptions ?inputs =ctor-args =body))))
+ (return (&/V &/$ConstructorMethodAnalysis (&/T [?anns ?gvars ?exceptions ?inputs =ctor-args =body]))))
(&/$VirtualMethodSyntax ?name ?anns ?gvars ?exceptions ?inputs ?output ?body)
(|do [method-env (&/map% (fn [gvar]
(|do [ex &type/existential]
- (return (&/T gvar ex))))
+ (return (&/T [gvar ex]))))
?gvars)
:let [full-env (&/|++ class-env method-env)]
output-type (generic-class->type full-env ?output)
@@ -602,13 +602,13 @@
body*)))
(&&/analyse-1 analyse output-type ?body)
(&/|reverse ?inputs))))]
- (return (&/V &/$VirtualMethodAnalysis (&/T ?name ?anns ?gvars ?exceptions ?inputs ?output =body))))
+ (return (&/V &/$VirtualMethodAnalysis (&/T [?name ?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)
method-env (&/map% (fn [gvar]
(|do [ex &type/existential]
- (return (&/T gvar ex))))
+ (return (&/T [gvar ex]))))
?gvars)
:let [full-env (&/|++ super-env method-env)]
output-type (generic-class->type full-env ?output)
@@ -621,7 +621,7 @@
body*)))
(&&/analyse-1 analyse output-type ?body)
(&/|reverse ?inputs))))]
- (return (&/V &/$OverridenMethodAnalysis (&/T ?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output =body))))
+ (return (&/V &/$OverridenMethodAnalysis (&/T [?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output =body]))))
)))
(defn ^:private mandatory-methods [supers]
@@ -673,18 +673,18 @@
all-supers (&/Cons$ super-class interfaces)]
class-env (&/map% (fn [gvar]
(|do [ex &type/existential]
- (return (&/T gvar ex))))
+ (return (&/T [gvar ex]))))
?params)
_ (&host/use-dummy-class class-decl super-class interfaces &/None$ =fields methods)
=methods (&/map% (partial analyse-method analyse class-decl class-env all-supers) methods)
_ (check-method-completion all-supers =methods)
- _ (compile-token (&/V &&/$jvm-class (&/T class-decl super-class interfaces =anns =fields =methods (&/|list) &/None$)))
+ _ (compile-token (&/V &&/$jvm-class (&/T [class-decl super-class interfaces =anns =fields =methods (&/|list) &/None$])))
:let [_ (println 'DEF full-name)]]
(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 (&/V &&/$jvm-interface (&/T [interface-decl supers =anns =methods])))
:let [_ (println 'DEF (str module "." (&/|first interface-decl)))]]
(return &/Nil$)))
@@ -693,26 +693,26 @@
[name [_ (&&/$captured _ _ source)]]
source))
-(let [default-<init> (&/V &/$ConstructorMethodSyntax (&/T (&/|list)
- (&/|list)
- (&/|list)
- (&/|list)
- (&/|list)
- (&/V &/$TupleS (&/|list))))
+(let [default-<init> (&/V &/$ConstructorMethodSyntax (&/T [(&/|list)
+ (&/|list)
+ (&/|list)
+ (&/|list)
+ (&/|list)
+ (&/V &/$TupleS (&/|list))]))
captured-slot-class "java.lang.Object"
- captured-slot-type (&/V &/$GenericClass (&/T captured-slot-class (&/|list)))]
+ captured-slot-type (&/V &/$GenericClass (&/T [captured-slot-class (&/|list)]))]
(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 (&/|list)])
anon-class (str module "." name)
anon-class-type (&type/Data$ anon-class (&/|list))]
=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)))))
+ (return (&/T [arg-type =arg-term])))))
ctor-args)
_ (->> methods
(&/Cons$ default-<init>)
@@ -724,15 +724,15 @@
=captured &&env/captured-vars
:let [=fields (&/|map (fn [^objects idx+capt]
(|let [[idx _] idx+capt]
- (&/T (str &c!base/closure-prefix idx)
- (&/|list)
- captured-slot-type)))
+ (&/T [(str &c!base/closure-prefix idx)
+ (&/|list)
+ captured-slot-type])))
(&/enumerate =captured))]
:let [sources (&/|map captured-source =captured)]
- _ (compile-token (&/V &&/$jvm-class (&/T class-decl super-class interfaces (&/|list) =fields =methods =captured (&/Some$ =ctor-args))))
+ _ (compile-token (&/V &&/$jvm-class (&/T [class-decl super-class interfaces (&/|list) =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))
+ (&/V &&/$jvm-new (&/T [anon-class (&/|repeat (&/|length sources) captured-slot-class) sources]))
)))
))))
@@ -743,7 +743,7 @@
=catch-body (&&env/with-local ?ex-arg (&type/Data$ ?ex-class &/Nil$)
(&&/analyse-1 analyse exo-type ?catch-body))
idx &&env/next-local-idx]
- (return (&/T ?ex-class idx =catch-body))))
+ (return (&/T [?ex-class idx =catch-body]))))
?catches)
:let [catched-exceptions (&/|map (fn [=catch]
(|let [[_c-class _ _] =catch]
@@ -757,7 +757,7 @@
(return (&/V &/$Some =finally))))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$jvm-try (&/T =body =catches =finally)))))))
+ (&/V &&/$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)
diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj
index bbb5d2dc7..8d94d4ab6 100644
--- a/src/lux/analyser/lambda.clj
+++ b/src/lux/analyser/lambda.clj
@@ -19,15 +19,15 @@
(&env/with-local arg arg-type
(|do [=return body
=captured &env/captured-vars]
- (return (&/T scope-name =captured =return))))))))
+ (return (&/T [scope-name =captured =return]))))))))
(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)))]
- (&/T register* (&/update$ &/$closure #(->> %
- (&/update$ &/$counter inc)
- (&/update$ &/$mappings (fn [mps] (&/|put name register* mps))))
- frame))))
+ (&/V &&/$captured (&/T [scope
+ (->> frame (&/get$ &/$closure) (&/get$ &/$counter))
+ register])))]
+ (&/T [register* (&/update$ &/$closure #(->> %
+ (&/update$ &/$counter inc)
+ (&/update$ &/$mappings (fn [mps] (&/|put name register* mps))))
+ frame)])))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 4bfe10873..68e329af2 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -212,7 +212,7 @@
" " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))))
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$variant (&/T idx =value))
+ (&/V &&/$variant (&/T [idx =value]))
))))
(&/$UnivQ _)
@@ -262,7 +262,7 @@
(&type/check exo-type endo-type))
_cursor &/cursor]
(return (&/|list (&&/|meta endo-type _cursor
- (&/V &&/$var (&/V &/$Global (&/T r-module r-name)))
+ (&/V &&/$var (&/V &/$Global (&/T [r-module r-name])))
)))))
(defn ^:private analyse-local [analyse exo-type name]
@@ -295,10 +295,10 @@
[=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 (or (->> top-outer (&/get$ &/$locals) (&/get$ &/$mappings) (&/|get name))
- (->> top-outer (&/get$ &/$closure) (&/get$ &/$mappings) (&/|get name)))
- &/Nil$)
+ (&/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$])
(&/|reverse inner) scopes)]
((|do [_ (&type/check exo-type (&&/expr-type* =local))]
(return (&/|list =local)))
@@ -316,7 +316,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)]
@@ -334,7 +334,7 @@
(&type/clean $var =output-t)
(|do [_ (&type/set-var ?id (&/V &/$BoundT 1))]
(&type/clean $var =output-t)))]
- (return (&/T type** =args)))
+ (return (&/T [type** =args])))
))))
(&/$ExQ _)
@@ -348,7 +348,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*))))
@@ -360,7 +360,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))
+ (&/V &&/$apply (&/T [=fn =args]))
)))))
(defn analyse-apply [analyse exo-type =fn ?args]
@@ -404,7 +404,7 @@
=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))
+ (&/V &&/$case (&/T [=value =match]))
)))))
(defn analyse-lambda* [analyse exo-type ?self ?arg ?body]
@@ -460,7 +460,7 @@
(&&/analyse-1 analyse ?return-t ?body))
_cursor &/cursor]
(return (&&/|meta exo-type* _cursor
- (&/V &&/$lambda (&/T =scope =captured =body)))))
+ (&/V &&/$lambda (&/T [=scope =captured =body])))))
@@ -507,7 +507,7 @@
==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)))]
+ _ (compile-token (&/V &&/$def (&/T [?name =value ==meta])))]
(return &/Nil$))
)))
@@ -538,7 +538,7 @@
=value (&&/analyse-1 analyse ==type ?value)
_cursor &/cursor]
(return (&/|list (&&/|meta ==type _cursor
- (&/V &&/$ann (&/T =value =type ==type))
+ (&/V &&/$ann (&/T [=value =type ==type]))
)))))
(defn analyse-coerce [analyse eval! exo-type ?type ?value]
@@ -548,5 +548,5 @@
=value (&&/analyse-1+ analyse ?value)
_cursor &/cursor]
(return (&/|list (&&/|meta ==type _cursor
- (&/V &&/$coerce (&/T =value =type ==type))
+ (&/V &&/$coerce (&/T [=value =type ==type]))
)))))
diff --git a/src/lux/analyser/meta.clj b/src/lux/analyser/meta.clj
index fb75003e8..185391678 100644
--- a/src/lux/analyser/meta.clj
+++ b/src/lux/analyser/meta.clj
@@ -28,10 +28,14 @@
(meta-get ident dict*))
(&/$Nil)
- &/None$))
+ &/None$
+
+ _
+ (assert false (prn-str (&/adt->text ident)
+ (&/adt->text dict)))))
(do-template [<name> <tag-name>]
- (def <name> (&/T tag-prefix <tag-name>))
+ (def <name> (&/T [tag-prefix <tag-name>]))
type?-tag "type?"
alias-tag "alias"
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index 158fd7487..16c020670 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -24,17 +24,17 @@
"types"])
(def ^:private +init+
- (&/T ;; "lux;module-aliases"
- (&/|table)
- ;; "lux;defs"
- (&/|table)
- ;; "lux;imports"
- &/Nil$
- ;; "lux;tags"
- (&/|table)
- ;; "lux;types"
- (&/|table)
- ))
+ (&/T [;; "lux;module-aliases"
+ (&/|table)
+ ;; "lux;defs"
+ (&/|table)
+ ;; "lux;imports"
+ &/Nil$
+ ;; "lux;tags"
+ (&/|table)
+ ;; "lux;types"
+ (&/|table)]
+ ))
;; [Exports]
(defn add-import [module]
@@ -73,7 +73,7 @@
(&/|update module
(fn [m]
(&/update$ $defs
- #(&/|put name (&/T def-type def-meta def-value) %)
+ #(&/|put name (&/T [def-type def-meta def-value]) %)
m))
ms))))
nil)
@@ -102,8 +102,8 @@
(return* state ?value)
_
- (fail* (str "[Analyser Error] Not a type: " (&/ident->text (&/T module name))))))
- (fail* (str "[Analyser Error] Unknown definition: " (&/ident->text (&/T module name)))))
+ (fail* (str "[Analyser Error] Not a type: " (&/ident->text (&/T [module name]))))))
+ (fail* (str "[Analyser Error] Unknown definition: " (&/ident->text (&/T [module name])))))
(fail* (str "[Analyser Error] Unknown module: " module)))))
(defn exists? [name]
@@ -147,10 +147,10 @@
state)
_
- (return* state (&/T (&/T module name) $def)))
+ (return* state (&/T [(&/T [module name]) $def])))
(|case (&meta/meta-get &meta/export?-tag ?meta)
(&/$Some (&/$BoolM true))
- (return* state (&/T (&/T module name) $def))
+ (return* state (&/T [(&/T [module name]) $def]))
_
(fail* (str "[Analyser Error] Can't use unexported definition: " (str module &/+name-separator+ name))))))
@@ -207,7 +207,7 @@
(|do [tags-table (tags-by-module module)
_ (&/map% (fn [tag]
(if (&/|get tag tags-table)
- (fail (str "[Analyser Error] Can't re-declare tag: " (&/ident->text (&/T module tag))))
+ (fail (str "[Analyser Error] Can't re-declare tag: " (&/ident->text (&/T [module tag]))))
(return nil)))
tags)]
(return nil)))
@@ -215,7 +215,7 @@
(defn ensure-undeclared-type [module name]
(|do [types-table (types-by-module module)
_ (&/assert! (nil? (&/|get name types-table))
- (str "[Analyser Error] Can't re-declare type: " (&/ident->text (&/T module name))))]
+ (str "[Analyser Error] Can't re-declare type: " (&/ident->text (&/T [module name]))))]
(return nil)))
(defn declare-tags [module tag-names type]
@@ -228,17 +228,17 @@
_ (ensure-undeclared-type _module _name)]
(fn [state]
(if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
- (let [tags (&/|map (fn [tag-name] (&/T module tag-name)) tag-names)]
+ (let [tags (&/|map (fn [tag-name] (&/T [module tag-name])) tag-names)]
(return* (&/update$ &/$modules
(fn [=modules]
(&/|update module
#(->> %
(&/set$ $tags (&/fold (fn [table idx+tag-name]
(|let [[idx tag-name] idx+tag-name]
- (&/|put tag-name (&/T idx tags type) table)))
+ (&/|put tag-name (&/T [idx tags type]) table)))
(&/get$ $tags %)
(&/enumerate tag-names)))
- (&/update$ $types (partial &/|put _name (&/T tags type))))
+ (&/update$ $types (partial &/|put _name (&/T [tags type]))))
=modules))
state)
nil))
@@ -252,7 +252,7 @@
(if-let [^objects idx+tags+type (&/|get tag-name (&/get$ $tags =module))]
(|let [[?idx ?tags ?type] idx+tags+type]
(return* state <part>))
- (fail* (str "[Module Error] Unknown tag: " (&/ident->text (&/T module tag-name)))))
+ (fail* (str "[Module Error] Unknown tag: " (&/ident->text (&/T [module tag-name])))))
(fail* (str "[Module Error] Unknown module: " module)))))
tag-index ?idx "(-> Text Text (Lux Int))"
@@ -269,10 +269,10 @@
(|let [[k [?def-type ?def-meta ?def-value]] kv]
(|case (&meta/meta-get &meta/alias-tag ?def-meta)
(&/$Some (&/$IdentM [?r-module ?r-name]))
- (&/T k (str ?r-module ";" ?r-name))
+ (&/T [k (str ?r-module ";" ?r-name)])
_
- (&/T k "")
+ (&/T [k ""])
)))))))))
(do-template [<name> <type> <tag> <desc>]
diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj
index 8a843dc59..611d65a83 100644
--- a/src/lux/analyser/parser.clj
+++ b/src/lux/analyser/parser.clj
@@ -30,7 +30,7 @@
(|case ast
[_ (&/$FormS (&/$Cons [_ (&/$TextS class-name)] (&/$Cons [_ (&/$TupleS args)] (&/$Nil))))]
(|do [=args (&/map% parse-text args)]
- (return (&/T class-name =args)))
+ (return (&/T [class-name =args])))
_
(fail (str "[Analyser Error] Not generic class declaration: " (&/show-ast ast)))))
@@ -45,7 +45,7 @@
[_ (&/$FormS (&/$Cons [_ (&/$TextS class-name)] (&/$Cons [_ (&/$TupleS params)] (&/$Nil))))]
(|do [=params (&/map% parse-gclass params)]
- (return (&/V &/$GenericClass (&/T class-name =params))))
+ (return (&/V &/$GenericClass (&/T [class-name =params]))))
[_ (&/$FormS (&/$Cons [_ (&/$TextS "Array")] (&/$Cons param (&/$Nil))))]
(|do [=param (parse-gclass param)]
@@ -58,7 +58,7 @@
(|case ast
[_ (&/$FormS (&/$Cons [_ (&/$TextS class-name)] (&/$Cons [_ (&/$TupleS params)] (&/$Nil))))]
(|do [=params (&/map% parse-gclass params)]
- (return (&/T class-name =params)))
+ (return (&/T [class-name =params])))
_
(fail (str "[Analyser Error] Not generic super-class: " (&/show-ast ast)))))
@@ -67,7 +67,7 @@
(|case ast
[_ (&/$TupleS (&/$Cons ?class (&/$Cons ?term (&/$Nil))))]
(|do [=class (parse-gclass ?class)]
- (return (&/T =class ?term)))
+ (return (&/T [=class ?term])))
_
(fail (str "[Analyser Error] Not constructor argument: " (&/show-ast ast)))))
@@ -80,12 +80,12 @@
(&/$Cons [_ (&/$SymbolS "" ?ex-arg)]
(&/$Cons ?catch-body
(&/$Nil))))))]
- (return (&/T (&/|++ catch+ (&/|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+))
+ (return (&/T [(&/|++ catch+ (&/|list (&/T [?ex-class ?ex-arg ?catch-body]))) finally+]))
[meta (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_finally")]
(&/$Cons ?finally-body
(&/$Nil))))]
- (return (&/T catch+ (&/V &/$Some ?finally-body)))
+ (return (&/T [catch+ (&/V &/$Some ?finally-body)]))
_
(fail (str "[Analyser Error] Wrong syntax for exception handler: " (&/show-ast token))))))
@@ -95,11 +95,11 @@
(|case param
[[_ (&/$TextS param-name)] param-value]
(|case param-value
- [_ (&/$BoolS param-value*)] (return (&/T param-name (boolean param-value*)))
- [_ (&/$IntS param-value*)] (return (&/T param-name (int param-value*)))
- [_ (&/$RealS param-value*)] (return (&/T param-name (float param-value*)))
- [_ (&/$CharS param-value*)] (return (&/T param-name (char param-value*)))
- [_ (&/$TextS param-value*)] (return (&/T param-name param-value*))
+ [_ (&/$BoolS param-value*)] (return (&/T [param-name (boolean param-value*)]))
+ [_ (&/$IntS param-value*)] (return (&/T [param-name (int param-value*)]))
+ [_ (&/$RealS param-value*)] (return (&/T [param-name (float param-value*)]))
+ [_ (&/$CharS param-value*)] (return (&/T [param-name (char param-value*)]))
+ [_ (&/$TextS param-value*)] (return (&/T [param-name param-value*]))
_
failure)
@@ -123,7 +123,7 @@
(&/$Cons gclass
(&/$Nil))))]
(|do [=gclass (parse-gclass gclass)]
- (return (&/T arg-name =gclass)))
+ (return (&/T [arg-name =gclass])))
_
(fail (str "[Analyser Error] Invalid argument declaration: " (&/show-ast ast)))))
@@ -141,7 +141,7 @@
=exceptions (&/map% parse-gclass exceptions)
=inputs (&/map% parse-gclass inputs)
=output (parse-gclass output)]
- (return (&/T method-name =anns =gvars =exceptions =inputs =output)))
+ (return (&/T [method-name =anns =gvars =exceptions =inputs =output])))
_
(fail (str "[Analyser Error] Invalid method declaration: " (&/show-ast ast)))))
@@ -160,7 +160,7 @@
=exceptions (&/map% parse-gclass exceptions)
=inputs (&/map% parse-arg-decl inputs)
=ctor-args (&/map% parse-ctor-arg ?ctor-args)]
- (return (&/V &/$ConstructorMethodSyntax (&/T =anns =gvars =exceptions =inputs =ctor-args body))))
+ (return (&/V &/$ConstructorMethodSyntax (&/T [=anns =gvars =exceptions =inputs =ctor-args body]))))
_
(fail "")))
@@ -180,7 +180,7 @@
=exceptions (&/map% parse-gclass exceptions)
=inputs (&/map% parse-arg-decl inputs)
=output (parse-gclass output)]
- (return (&/V &/$VirtualMethodSyntax (&/T ?name =anns =gvars =exceptions =inputs =output body))))
+ (return (&/V &/$VirtualMethodSyntax (&/T [?name =anns =gvars =exceptions =inputs =output body]))))
_
(fail "")))
@@ -203,7 +203,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 (&/V &/$OverridenMethodSyntax (&/T [=class-decl =name =anns =gvars =exceptions =inputs =output body]))))
_
(fail "")))
@@ -223,7 +223,7 @@
(&/$Nil)))))]
(|do [=anns (&/map% parse-ann ?anns)
=type (parse-gclass ?type)]
- (return (&/T ?name =anns =type)))
+ (return (&/T [?name =anns =type])))
_
(fail (str "[Analyser Error] Invalid field declaration: " (&/show-ast ast)))))
diff --git a/src/lux/analyser/record.clj b/src/lux/analyser/record.clj
index ddc9616fd..67cc78c0c 100644
--- a/src/lux/analyser/record.clj
+++ b/src/lux/analyser/record.clj
@@ -16,13 +16,13 @@
"(-> (List (, Syntax Syntax)) (Lux (List Syntax)))"
(|do [[tag-group tag-type] (|case pairs
(&/$Nil)
- (return (&/T &/Nil$ &type/Unit))
+ (return (&/T [&/Nil$ &type/Unit]))
(&/$Cons [[_ (&/$TagS tag1)] _] _)
(|do [[module name] (&&/resolved-ident tag1)
tags (&&module/tag-group module name)
type (&&module/tag-type module name)]
- (return (&/T tags type)))
+ (return (&/T [tags type])))
_
(fail "[Analyser Error] Wrong syntax for records. Odd elements must be tags."))
@@ -30,7 +30,7 @@
(|case kv
[[_ (&/$TagS k)] v]
(|do [=k (&&/resolved-ident k)]
- (return (&/T (&/ident->text =k) v)))
+ (return (&/T [(&/ident->text =k) v])))
_
(fail "[Analyser Error] Wrong syntax for records. Odd elements must be tags.")))
@@ -40,4 +40,4 @@
(return member)
(fail (str "[Analyser Error] Unknown tag: " tag))))
(&/|map &/ident->text tag-group))]
- (return (&/T =members tag-type))))
+ (return (&/T [=members tag-type]))))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 1a8cde61b..d74b02402 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -144,10 +144,10 @@
(def tags-field "_tags")
(def module-class-name "_")
(def +name-separator+ ";")
-(def sum-tag (str (char 0) "sum" (char 0)))
-(def product-tag (str (char 0) "product" (char 0)))
+(def sum-tag (.intern (str (char 0) "sum" (char 0))))
+(def product-tag (.intern (str (char 0) "product" (char 0))))
-(defn T [& elems]
+(defn T [elems]
(case (count elems)
0
nil
@@ -156,7 +156,7 @@
(first elems)
;; else
- (to-array [product-tag (int 0) (to-array elems)])))
+ (to-array (conj elems product-tag))))
(defn V [^Long tag value]
(to-array [sum-tag tag value]))
@@ -166,16 +166,16 @@
(defn Some$ [x] (V $Some x))
(def Nil$ (V $Nil nil))
-(defn Cons$ [h t] (V $Cons (T h t)))
+(defn Cons$ [h t] (V $Cons (T [h t])))
-(def empty-cursor (T "" -1 -1))
+(def empty-cursor (T ["" -1 -1]))
(defn get$ [slot ^objects record]
- (aget ^objects (aget record 2) slot))
+ (aget record slot))
(defn set$ [slot value ^objects record]
- (to-array [product-tag (int 0) (doto (aclone ^objects (aget record 2))
- (aset slot value))]))
+ (doto (aclone ^objects record)
+ (aset slot value)))
(defmacro update$ [slot f record]
`(let [record# ~record]
@@ -186,7 +186,7 @@
(V $Left message))
(defn return* [state value]
- (V $Right (T state value)))
+ (V $Right (T [state value])))
(defn transform-pattern [pattern]
(cond (vector? pattern) (case (count pattern)
@@ -197,7 +197,7 @@
(first pattern)
;; else
- ['_ '_ (mapv transform-pattern pattern)])
+ (conj (mapv transform-pattern pattern) '_))
(seq? pattern) (let [parts (mapv transform-pattern (rest pattern))]
['_
(eval (first pattern))
@@ -205,14 +205,14 @@
0 nil
1 (first parts)
;; else
- ['_ '_ parts])])
+ (conj parts '_))])
:else pattern
))
(defmacro |case [value & branches]
(assert (= 0 (mod (count branches) 2)))
(let [value* (if (vector? value)
- [`(T ~@value)]
+ [`(T [~@value])]
[value])]
`(matchv ::M/objects ~value*
~@(mapcat (fn [[pattern body]]
@@ -230,7 +230,7 @@
(defmacro |list [& elems]
(reduce (fn [tail head]
- `(V $Cons (T ~head ~tail)))
+ `(V $Cons (T [~head ~tail])))
`Nil$
(reverse elems)))
@@ -253,12 +253,12 @@
(defn |put [slot value table]
(|case table
($Nil)
- (V $Cons (T (T slot value) Nil$))
+ (V $Cons (T [(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*))))
+ (V $Cons (T [(T [slot value]) table*]))
+ (V $Cons (T [(T [k v]) (|put slot value table*)])))
))
(defn |remove [slot table]
@@ -269,7 +269,7 @@
($Cons [k v] table*)
(if (.equals ^Object k slot)
table*
- (V $Cons (T (T k v) (|remove slot table*))))))
+ (V $Cons (T [(T [k v]) (|remove slot table*)])))))
(defn |update [k f table]
(|case table
@@ -278,8 +278,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*))))))
+ (V $Cons (T [(T [k* (f v)]) table*]))
+ (V $Cons (T [(T [k* v]) (|update k f table*)])))))
(defn |head [xs]
(|case xs
@@ -304,7 +304,7 @@
(defn return [value]
(fn [state]
- (V $Right (T state value))))
+ (V $Right (T [state value]))))
(defn bind [m-value step]
(fn [state]
@@ -344,7 +344,7 @@
ys
($Cons x xs*)
- (V $Cons (T x (|++ xs* ys)))))
+ (V $Cons (T [x (|++ xs* ys)]))))
(defn |map [f xs]
(|case xs
@@ -352,7 +352,7 @@
xs
($Cons x xs*)
- (V $Cons (T (f x) (|map f xs*)))))
+ (V $Cons (T [(f x) (|map f xs*)]))))
(defn |empty? [xs]
"(All [a] (-> (List a) Bool))"
@@ -371,7 +371,7 @@
($Cons x xs*)
(if (p x)
- (V $Cons (T x (|filter p xs*)))
+ (V $Cons (T [x (|filter p xs*)]))
(|filter p xs*))))
(defn flat-map [f xs]
@@ -386,13 +386,13 @@
(defn |split-with [p xs]
(|case xs
($Nil)
- (T xs xs)
+ (T [xs xs])
($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
@@ -441,7 +441,7 @@
(let [|range* (fn |range* [from to]
(if (< from to)
- (V $Cons (T from (|range* (inc from) to)))
+ (V $Cons (T [from (|range* (inc from) to)]))
Nil$))]
(defn |range [n]
(|range* 0 n)))
@@ -457,7 +457,7 @@
(defn zip2 [xs ys]
(|case [xs ys]
[($Cons x xs*) ($Cons y ys*)]
- (V $Cons (T (T x y) (zip2 xs* ys*)))
+ (V $Cons (T [(T [x y]) (zip2 xs* ys*)]))
[_ _]
Nil$))
@@ -487,7 +487,7 @@
xs
($Cons x xs*)
- (V $Cons (T x (V $Cons (T sep (|interpose sep xs*)))))))
+ (V $Cons (T [x (V $Cons (T [sep (|interpose sep xs*)]))]))))
(do-template [<name> <joiner>]
(defn <name> [f xs]
@@ -509,7 +509,7 @@
(defn |as-pairs [xs]
(|case xs
($Cons x ($Cons y xs*))
- (V $Cons (T (T x y) (|as-pairs xs*)))
+ (V $Cons (T [(T [x y]) (|as-pairs xs*)]))
_
Nil$))
@@ -606,21 +606,21 @@
(return* state (->> state (get$ $host) (get$ $classes)))))
(def +init-bindings+
- (T ;; "lux;counter"
- 0
- ;; "lux;mappings"
- (|table)))
+ (T [;; "lux;counter"
+ 0
+ ;; "lux;mappings"
+ (|table)]))
(defn env [name]
- (T ;; "lux;name"
- name
- ;; "lux;inner-closures"
- 0
- ;; "lux;locals"
- +init-bindings+
- ;; "lux;closure"
- +init-bindings+
- ))
+ (T [;; "lux;name"
+ name
+ ;; "lux;inner-closures"
+ 0
+ ;; "lux;locals"
+ +init-bindings+
+ ;; "lux;closure"
+ +init-bindings+]
+ ))
(let [define-class (doto (.getDeclaredMethod java.lang.ClassLoader "defineClass" (into-array [String
(class (byte-array []))
@@ -650,39 +650,39 @@
;; #module-states (List (, Text ModuleState))))
(defn host [_]
(let [store (atom {})]
- (T ;; "lux;writer"
- (V $None nil)
- ;; "lux;loader"
- (memory-class-loader store)
- ;; "lux;classes"
- store
- ;; "lux;catching"
- Nil$
- ;; "lux;module-states"
- (|table)
- ;; lux;type-env
- (|table))))
+ (T [;; "lux;writer"
+ (V $None nil)
+ ;; "lux;loader"
+ (memory-class-loader store)
+ ;; "lux;classes"
+ store
+ ;; "lux;catching"
+ Nil$
+ ;; "lux;module-states"
+ (|table)
+ ;; lux;type-env
+ (|table)])))
(defn init-state [_]
- (T ;; "lux;source"
- (V $None nil)
- ;; "lux;cursor"
- (T "" -1 -1)
- ;; "lux;modules"
- (|table)
- ;; "lux;envs"
- Nil$
- ;; "lux;types"
- +init-bindings+
- ;; "lux;expected"
- (V $VoidT nil)
- ;; "lux;seed"
- 0
- ;; "lux;eval?"
- false
- ;; "lux;host"
- (host nil)
- ))
+ (T [;; "lux;source"
+ (V $None nil)
+ ;; "lux;cursor"
+ (T ["" -1 -1])
+ ;; "lux;modules"
+ (|table)
+ ;; "lux;envs"
+ Nil$
+ ;; "lux;types"
+ +init-bindings+
+ ;; "lux;expected"
+ (V $VoidT nil)
+ ;; "lux;seed"
+ 0
+ ;; "lux;eval?"
+ false
+ ;; "lux;host"
+ (host nil)]
+ ))
(defn save-module [body]
(fn [state]
@@ -939,8 +939,8 @@
"(All [a] (-> Int (List a) (List (, Int a))))"
(|case xs
($Cons x xs*)
- (V $Cons (T (T idx x)
- (enumerate* (inc idx) xs*)))
+ (V $Cons (T [(T [idx x])
+ (enumerate* (inc idx) xs*)]))
($Nil)
xs
@@ -982,7 +982,7 @@
"(-> Ident (Lux Ident))"
(|case ident
["" name] (|do [module get-module-name]
- (return (T module name)))
+ (return (T [module name])))
_ (return ident)))
(defn ident= [x y]
@@ -998,10 +998,10 @@
($Cons x xs*)
(if (= idx 0)
- (V $Some (V $Cons (T val xs*)))
+ (V $Some (V $Cons (T [val xs*])))
(|case (|list-put (dec idx) val xs*)
($None) (V $None nil)
- ($Some xs**) (V $Some (V $Cons (T x xs**))))
+ ($Some xs**) (V $Some (V $Cons (T [x xs**]))))
)))
(do-template [<flagger> <asker> <tag>]
@@ -1014,15 +1014,15 @@
(|put module (V <tag> nil) module-states))
host))
state)]
- (V $Right (T state* nil)))))
+ (V $Right (T [state* nil])))))
(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)))
+ (V $Right (T [state (|case module-state
+ (<tag>) true
+ _ false)]))
+ (V $Right (T [state false])))
)))
flag-active-module active-module? $Active
@@ -1083,25 +1083,25 @@
state)]
(|case (body state*)
($Right [state** output])
- (V $Right (T (update$ $host
- #(set$ $type-env
- (->> state (get$ $host) (get$ $type-env))
- %)
- state**)
- output))
+ (V $Right (T [(update$ $host
+ #(set$ $type-env
+ (->> state (get$ $host) (get$ $type-env))
+ %)
+ state**)
+ output]))
($Left msg)
(V $Left msg)))))
(defn |take [n xs]
- (|case (T n xs)
+ (|case (T [n xs])
[0 _] Nil$
[_ ($Nil)] Nil$
[_ ($Cons x xs*)] (Cons$ x (|take (dec n) xs*))
))
(defn |drop [n xs]
- (|case (T n xs)
+ (|case (T [n xs])
[0 _] xs
[_ ($Nil)] Nil$
[_ ($Cons x xs*)] (|drop (dec n) xs*)
diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj
index fac6b666a..da49ef419 100644
--- a/src/lux/compiler/cache.clj
+++ b/src/lux/compiler/cache.clj
@@ -116,7 +116,7 @@
(string/split tag-group-separator-re)
(->> (map (fn [_group]
(let [[_type _tags] (string/split _group type-separator-re)]
- (&/T _type (&/->list (string/split (or _tags "") tag-separator-re)))))))
+ (&/T [_type (&/->list (string/split (or _tags "") tag-separator-re))])))))
&/->list)))]
(|do [_ (&a-module/enter-module module)
_ (&/flag-cached-module module)
@@ -137,7 +137,7 @@
(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 (&/V &/$IdentM (&/T [__module __name]))]))
def-value (get-field &/value-field def-class)]
(&a-module/define module _name def-type def-meta def-value)))
))
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 1f2188a2f..5e9aacc0f 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -97,17 +97,12 @@
_
(doto writer
(.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int 2))
- (.visitInsn Opcodes/AALOAD)
- (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
(-> (doto (.visitInsn Opcodes/DUP)
(.visitLdcInsn (int idx))
(.visitInsn Opcodes/AALOAD)
(compile-match test $next $sub-else)
(.visitLabel $sub-else)
(.visitInsn Opcodes/POP)
- (.visitInsn Opcodes/POP)
(.visitJumpInsn Opcodes/GOTO $else)
(.visitLabel $next))
(->> (|let [[idx test] idx+member
@@ -115,7 +110,6 @@
$sub-else (new Label)])
(doseq [idx+member (->> ?members &/enumerate &/->seq)])))
(.visitInsn Opcodes/POP)
- (.visitInsn Opcodes/POP)
(.visitJumpInsn Opcodes/GOTO $target)))
(&a-case/$VariantTestAC ?tag ?count ?test)
@@ -146,17 +140,17 @@
(|let [[_ mappings patterns*] (&/fold (fn [$id+mappings+=matches pattern+body]
(|let [[$id mappings =matches] $id+mappings+=matches
[pattern body] pattern+body]
- (&/T (inc $id) (&/|put $id body mappings) (&/|put $id pattern =matches))))
- (&/T 0 (&/|table) (&/|table))
+ (&/T [(inc $id) (&/|put $id body mappings) (&/|put $id pattern =matches)])))
+ (&/T [0 (&/|table) (&/|table)])
patterns)]
- (&/T mappings (&/|reverse patterns*))))
+ (&/T [mappings (&/|reverse patterns*)])))
(defn ^:private compile-pattern-matching [^MethodVisitor writer compile mappings patterns $end]
(let [entries (&/|map (fn [?branch+?body]
(|let [[?branch ?body] ?branch+?body
label (new Label)]
- (&/T (&/T ?branch label)
- (&/T label ?body))))
+ (&/T [(&/T [?branch label])
+ (&/T [label ?body])])))
mappings)
mappings* (&/|map &/|first entries)]
(doto writer
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 01b73014c..a6f413595 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -494,8 +494,8 @@
(defn ^:private compile-method-def [compile ^ClassWriter class-writer ?super-class method-def]
(|case method-def
(&/$ConstructorMethodAnalysis ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body)
- (|let [?output (&/V &/$GenericClass (&/T "void" (&/|list)))
- =method-decl (&/T init-method ?anns ?gvars ?exceptions (&/|map &/|second ?inputs) ?output)
+ (|let [?output (&/V &/$GenericClass (&/T ["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
Opcodes/ACC_PUBLIC
@@ -522,7 +522,7 @@
(return nil))))
(&/$VirtualMethodAnalysis ?name ?anns ?gvars ?exceptions ?inputs ?output ?body)
- (|let [=method-decl (&/T ?name ?anns ?gvars ?exceptions (&/|map &/|second ?inputs) ?output)
+ (|let [=method-decl (&/T [?name ?anns ?gvars ?exceptions (&/|map &/|second ?inputs) ?output])
[simple-signature generic-signature] (&host-generics/method-signatures =method-decl)]
(&/with-writer (.visitMethod class-writer
Opcodes/ACC_PUBLIC
@@ -541,7 +541,7 @@
(return nil))))
(&/$OverridenMethodAnalysis ?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output ?body)
- (|let [=method-decl (&/T ?name ?anns ?gvars ?exceptions (&/|map &/|second ?inputs) ?output)
+ (|let [=method-decl (&/T [?name ?anns ?gvars ?exceptions (&/|map &/|second ?inputs) ?output])
[simple-signature generic-signature] (&host-generics/method-signatures =method-decl)]
(&/with-writer (.visitMethod class-writer
Opcodes/ACC_PUBLIC
@@ -679,16 +679,16 @@
(&&/save-class! interface-name (.toByteArray =interface))))
(def compile-Function-class
- (let [object-class (&/V &/$GenericClass (&/T "java.lang.Object" (&/|list)))
- interface-decl (&/T (second (string/split &&/function-class #"/")) (&/|list))
+ (let [object-class (&/V &/$GenericClass (&/T ["java.lang.Object" (&/|list)]))
+ interface-decl (&/T [(second (string/split &&/function-class #"/")) (&/|list)])
?supers (&/|list)
?anns (&/|list)
- ?methods (&/|list (&/T "apply"
- (&/|list)
- (&/|list)
- (&/|list)
- (&/|list object-class)
- object-class))]
+ ?methods (&/|list (&/T ["apply"
+ (&/|list)
+ (&/|list)
+ (&/|list)
+ (&/|list object-class)
+ object-class]))]
(compile-jvm-interface nil interface-decl ?supers ?anns ?methods)))
(def compile-LuxUtils-class
@@ -731,7 +731,7 @@
(return nil)))
catch-boundaries (&/|map (fn [_catch_]
(|let [[?ex-class ?ex-idx ?catch-body] _catch_]
- (&/T ?ex-class (new Label) (new Label))))
+ (&/T [?ex-class (new Label) (new Label)])))
?catches)
_ (doseq [catch-boundary (&/->seq catch-boundaries)]
(|let [[?ex-class $handler-start $handler-end] catch-boundary]
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 07418ec15..31f2fdb8c 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -66,21 +66,7 @@
_
(|do [:let [_ (doto *writer*
- (.visitLdcInsn (int 3))
- (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object")
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int 0))
- (.visitFieldInsn Opcodes/GETSTATIC &&/lux-utils-class &&/product-tag-field "Ljava/lang/String;")
- (.visitInsn Opcodes/AASTORE)
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int 1))
- (.visitLdcInsn (int 0))
- (&&/wrap-int)
- (.visitInsn Opcodes/AASTORE)
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int 2)))]
- :let [_ (doto *writer*
- (.visitLdcInsn (int num-elems))
+ (.visitLdcInsn (int (inc num-elems)))
(.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object"))]
_ (&/map2% (fn [idx elem]
(|do [:let [_ (doto *writer*
@@ -90,7 +76,11 @@
:let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
(return ret)))
(&/|range num-elems) ?elems)
- :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
+ :let [_ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int num-elems))
+ (.visitLdcInsn &/product-tag)
+ (.visitInsn Opcodes/AASTORE))]]
(return nil)))))
(defn compile-variant [compile ?tag ?value]
@@ -100,7 +90,7 @@
(.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object")
(.visitInsn Opcodes/DUP)
(.visitLdcInsn (int 0))
- (.visitFieldInsn Opcodes/GETSTATIC &&/lux-utils-class &&/sum-tag-field "Ljava/lang/String;")
+ (.visitLdcInsn &/sum-tag)
(.visitInsn Opcodes/AASTORE)
(.visitInsn Opcodes/DUP)
(.visitLdcInsn (int 1))
@@ -150,8 +140,8 @@
[[?def-type ?def-cursor] ?def-value]
(if (&type/type= &type/Type ?def-type)
- (&/T (&/T ?def-type ?def-cursor)
- (&/V &a/$tuple (&/|list)))
+ (&/T [(&/T [?def-type ?def-cursor])
+ (&/V &a/$tuple (&/|list))])
(&&type/type->analysis ?def-type)))]]
(compile ?def-type)))
@@ -217,19 +207,19 @@
:let [def-class (&&/load-class! class-loader (&host-generics/->class-name current-class))
[def-type is-type?] (|case (&a-meta/meta-get &a-meta/type?-tag ?meta)
(&/$Some (&/$BoolM true))
- (&/T &type/Type
- true)
+ (&/T [&type/Type
+ true])
_
(if (&type/type= &type/Type =value-type)
- (&/T &type/Type
- false)
- (&/T (-> def-class (.getField &/type-field) (.get nil))
- false)))
+ (&/T [&type/Type
+ false])
+ (&/T [(-> def-class (.getField &/type-field) (.get nil))
+ false])))
def-meta ?meta
def-value (-> def-class (.getField &/value-field) (.get nil))]
_ (&a-module/define module-name ?name def-type def-meta def-value)
- _ (|case (&/T is-type? (&a-meta/meta-get &a-meta/tags-tag def-meta))
+ _ (|case (&/T [is-type? (&a-meta/meta-get &a-meta/tags-tag def-meta)])
[true (&/$Some (&/$ListM tags*))]
(|do [tags (&/map% (fn [tag*]
(|case tag*
diff --git a/src/lux/compiler/module.clj b/src/lux/compiler/module.clj
index 7149e1370..23635f5bc 100644
--- a/src/lux/compiler/module.clj
+++ b/src/lux/compiler/module.clj
@@ -20,9 +20,9 @@
(return (&/|map (fn [pair]
(|case pair
[name [tags _]]
- (&/T name (&/|map (fn [tag]
- (|let [[t-prefix t-name] tag]
- t-name))
- tags))))
+ (&/T [name (&/|map (fn [tag]
+ (|let [[t-prefix t-name] tag]
+ t-name))
+ tags)])))
(&/get$ &module/$types module)))
))
diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj
index 0abb4d42e..1bfca2c1f 100644
--- a/src/lux/compiler/type.clj
+++ b/src/lux/compiler/type.clj
@@ -15,7 +15,7 @@
(defn ^:private variant$ [tag body]
"(-> Text Analysis Analysis)"
(&a/|meta &type/$Void &/empty-cursor
- (&/V &a/$variant (&/T tag body))))
+ (&/V &a/$variant (&/T [tag body]))))
(defn ^:private tuple$ [members]
"(-> (List Analysis) Analysis)"
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 473d0dc60..2f3799946 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -37,10 +37,10 @@
(|case type
(&/$DataT "#Array" (&/$Cons param (&/$Nil)))
(|let [[count inner] (unfold-array param)]
- (&/T (inc count) inner))
+ (&/T [(inc count) inner]))
_
- (&/T 0 type)))
+ (&/T [0 type])))
(let [ex-type-class (str "L" (&host-generics/->bytecode-class-name "java.lang.Object") ";")
object-array (str "[" "L" (&host-generics/->bytecode-class-name "java.lang.Object") ";")]
@@ -94,7 +94,7 @@
(.equals ^Object <static?> (Modifier/isStatic (.getModifiers =field))))]
(.getGenericType =field)))]
(|let [gvars (->> target-class .getTypeParameters seq &/->list)]
- (return (&/T gvars gtype)))
+ (return (&/T [gvars gtype])))
(fail (str "[Host Error] Field does not exist: " target "." field)))))
lookup-static-field true
@@ -117,11 +117,11 @@
(|let [parent-gvars (->> target-class .getTypeParameters seq &/->list)
gvars (->> method .getTypeParameters seq &/->list)
gargs (->> method .getGenericParameterTypes seq &/->list)]
- (return (&/T (.getGenericReturnType method)
- (->> method .getExceptionTypes &/->list (&/|map #(.getName ^Class %)))
- parent-gvars
- gvars
- gargs)))
+ (return (&/T [(.getGenericReturnType method)
+ (->> method .getExceptionTypes &/->list (&/|map #(.getName ^Class %)))
+ parent-gvars
+ gvars
+ gargs])))
(fail (str "[Host Error] " <method-type> " method does not exist: " target "." method-name)))))
lookup-static-method true "Static"
@@ -141,7 +141,7 @@
(|let [gvars (->> target-class .getTypeParameters seq &/->list)
gargs (->> ctor .getGenericParameterTypes seq &/->list)
exs (->> ctor .getExceptionTypes &/->list (&/|map #(.getName ^Class %)))]
- (return (&/T exs gvars gargs)))
+ (return (&/T [exs gvars gargs])))
(fail (str "[Host Error] Constructor does not exist: " target)))))
(defn abstract-methods [class-loader super-class]
@@ -149,7 +149,7 @@
(|let [[super-name super-params] super-class]
(return (&/->list (for [^Method =method (.getDeclaredMethods (Class/forName (&host-type/as-obj super-name) true class-loader))
:when (Modifier/isAbstract (.getModifiers =method))]
- (&/T (.getName =method) (&/|map #(.getName ^Class %) (&/->list (seq (.getParameterTypes =method))))))))))
+ (&/T [(.getName =method) (&/|map #(.getName ^Class %) (&/->list (seq (.getParameterTypes =method))))]))))))
(defn def-name [name]
(str (&/normalize-name name) "_" (hash name)))
@@ -274,7 +274,7 @@
(defn ^:private compile-dummy-method [^ClassWriter =class super-class method-def]
(|case method-def
(&/$ConstructorMethodSyntax =anns =gvars =exceptions =inputs =ctor-args body)
- (|let [=output (&/V &/$GenericClass (&/T "void" (&/|list)))
+ (|let [=output (&/V &/$GenericClass (&/T ["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
diff --git a/src/lux/host/generics.clj b/src/lux/host/generics.clj
index 5709fb615..0d34fe1a4 100644
--- a/src/lux/host/generics.clj
+++ b/src/lux/host/generics.clj
@@ -175,4 +175,4 @@
"(" (&/fold str "" (&/|map gclass->signature =inputs)) ")"
(gclass->signature =output)
(->> =exceptions (&/|map gclass->signature) (&/|interpose " ") (&/fold str "")))]
- (&/T simple-signature generic-signature)))
+ (&/T [simple-signature generic-signature])))
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index 0200ef8a9..b6de8091b 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -93,23 +93,23 @@
;; [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 (&/V $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 (&/V $Comment comment)]))))
(defn ^:private lex-multi-line-comment [_]
(|do [_ (&reader/read-text "#(")
[meta comment] (&/try-all% (&/|list (|do [[meta comment] (&reader/read-regex+ #"(?is)^(?!#\()((?!\)#).)*")]
- (return (&/T meta comment)))
+ (return (&/T [meta comment])))
(|do [[meta pre] (&reader/read-regex+ #"(?is)^((?!#\().)*")
[_ ($Comment inner)] (lex-multi-line-comment nil)
[_ post] (&reader/read-regex+ #"(?is)^((?!\)#).)*")]
- (return (&/T meta (str pre "#(" inner ")#" post))))))
+ (return (&/T [meta (str pre "#(" inner ")#" post)])))))
_ (&reader/read-text ")#")]
- (return (&/T meta (&/V $Comment comment)))))
+ (return (&/T [meta (&/V $Comment comment)]))))
(def ^:private lex-comment
(&/try-all% (&/|list lex-single-line-comment
@@ -118,7 +118,7 @@
(do-template [<name> <tag> <regex>]
(def <name>
(|do [[meta token] (&reader/read-regex <regex>)]
- (return (&/T meta (&/V <tag> token)))))
+ (return (&/T [meta (&/V <tag> token)]))))
^:private lex-bool $Bool #"^(true|false)"
^:private lex-int $Int #"^-?(0|[1-9][0-9]*)"
@@ -132,13 +132,13 @@
(|do [[_ char] (&reader/read-regex #"^(.)")]
(return char))))
_ (&reader/read-text "\"")]
- (return (&/T meta (&/V $Char token)))))
+ (return (&/T [meta (&/V $Char token)]))))
(def ^:private lex-text
(|do [[meta _] (&reader/read-text "\"")
token (lex-text-body false)
_ (&reader/read-text "\"")]
- (return (&/T meta (&/V $Text token)))))
+ (return (&/T [meta (&/V $Text token)]))))
(def ^:private lex-ident
(&/try-all% (&/|list (|do [[meta token] (&reader/read-regex +ident-re+)]
@@ -146,33 +146,33 @@
[_ local-token] (&reader/read-regex +ident-re+)
? (&module/exists? token)]
(if ?
- (return (&/T meta (&/T token local-token)))
+ (return (&/T [meta (&/T [token local-token])]))
(|do [unaliased (&module/dealias token)]
- (return (&/T meta (&/T unaliased local-token))))))
- (return (&/T meta (&/T "" token)))
+ (return (&/T [meta (&/T [unaliased local-token])])))))
+ (return (&/T [meta (&/T ["" token])]))
)))
(|do [[meta _] (&reader/read-text ";;")
[_ token] (&reader/read-regex +ident-re+)
module-name &/get-module-name]
- (return (&/T meta (&/T module-name token))))
+ (return (&/T [meta (&/T [module-name token])])))
(|do [[meta _] (&reader/read-text ";")
[_ token] (&reader/read-regex +ident-re+)]
- (return (&/T meta (&/T "lux" token))))
+ (return (&/T [meta (&/T ["lux" token])])))
)))
(def ^:private lex-symbol
(|do [[meta ident] lex-ident]
- (return (&/T meta (&/V $Symbol ident)))))
+ (return (&/T [meta (&/V $Symbol ident)]))))
(def ^:private lex-tag
(|do [[meta _] (&reader/read-text "#")
[_ ident] lex-ident]
- (return (&/T meta (&/V $Tag ident)))))
+ (return (&/T [meta (&/V $Tag ident)]))))
(do-template [<name> <text> <tag>]
(def <name>
(|do [[meta _] (&reader/read-text <text>)]
- (return (&/T meta (&/V <tag> nil)))))
+ (return (&/T [meta (&/V <tag> nil)]))))
^:private lex-open-paren "(" $Open_Paren
^:private lex-close-paren ")" $Close_Paren
diff --git a/src/lux/parser.clj b/src/lux/parser.clj
index d25010620..881619d4d 100644
--- a/src/lux/parser.clj
+++ b/src/lux/parser.clj
@@ -51,37 +51,37 @@
(return &/Nil$)
(&lexer/$Bool ?value)
- (return (&/|list (&/T meta (&/V &/$BoolS (Boolean/parseBoolean ?value)))))
+ (return (&/|list (&/T [meta (&/V &/$BoolS (Boolean/parseBoolean ?value))])))
(&lexer/$Int ?value)
- (return (&/|list (&/T meta (&/V &/$IntS (Long/parseLong ?value)))))
+ (return (&/|list (&/T [meta (&/V &/$IntS (Long/parseLong ?value))])))
(&lexer/$Real ?value)
- (return (&/|list (&/T meta (&/V &/$RealS (Double/parseDouble ?value)))))
+ (return (&/|list (&/T [meta (&/V &/$RealS (Double/parseDouble ?value))])))
(&lexer/$Char ^String ?value)
- (return (&/|list (&/T meta (&/V &/$CharS (.charAt ?value 0)))))
+ (return (&/|list (&/T [meta (&/V &/$CharS (.charAt ?value 0))])))
(&lexer/$Text ?value)
- (return (&/|list (&/T meta (&/V &/$TextS ?value))))
+ (return (&/|list (&/T [meta (&/V &/$TextS ?value)])))
(&lexer/$Symbol ?ident)
- (return (&/|list (&/T meta (&/V &/$SymbolS ?ident))))
+ (return (&/|list (&/T [meta (&/V &/$SymbolS ?ident)])))
(&lexer/$Tag ?ident)
- (return (&/|list (&/T meta (&/V &/$TagS ?ident))))
+ (return (&/|list (&/T [meta (&/V &/$TagS ?ident)])))
(&lexer/$Open_Paren _)
(|do [syntax (parse-form parse)]
- (return (&/|list (&/T meta syntax))))
+ (return (&/|list (&/T [meta syntax]))))
(&lexer/$Open_Bracket _)
(|do [syntax (parse-tuple parse)]
- (return (&/|list (&/T meta syntax))))
+ (return (&/|list (&/T [meta syntax]))))
(&lexer/$Open_Brace _)
(|do [syntax (parse-record parse)]
- (return (&/|list (&/T meta syntax))))
+ (return (&/|list (&/T [meta syntax]))))
_
(fail "[Parser Error] Unknown lexer token.")
diff --git a/src/lux/reader.clj b/src/lux/reader.clj
index 5d4a73504..ab3aed73e 100644
--- a/src/lux/reader.clj
+++ b/src/lux/reader.clj
@@ -72,9 +72,9 @@
(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) match))
- (&/V $Yes (&/T (&/T (&/T file-name line-num column-num) match)
- (&/T (&/T file-name line-num column-num*) line)))))
+ (&/V $Done (&/T [(&/T [file-name line-num column-num]) match]))
+ (&/V $Yes (&/T [(&/T [(&/T [file-name line-num column-num]) match])
+ (&/T [(&/T [file-name line-num column-num*]) line])]))))
(&/V $No (str "[Reader Error] Pattern failed: " regex))))))
(defn read-regex2 [regex]
@@ -84,9 +84,9 @@
(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) (&/T tok1 tok2)))
- (&/V $Yes (&/T (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))
- (&/T (&/T file-name line-num column-num*) line)))))
+ (&/V $Done (&/T [(&/T [file-name line-num column-num]) (&/T [tok1 tok2])]))
+ (&/V $Yes (&/T [(&/T [(&/T [file-name line-num column-num]) (&/T [tok1 tok2])])
+ (&/T [(&/T [file-name line-num column-num*]) line])]))))
(&/V $No (str "[Reader Error] Pattern failed: " regex))))))
(defn read-regex+ [regex]
@@ -108,9 +108,9 @@
(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 &/$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))))))))
(defn read-text [^String text]
@@ -120,16 +120,16 @@
(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) text))
- (&/V $Yes (&/T (&/T (&/T file-name line-num column-num) text)
- (&/T (&/T file-name line-num column-num*) line)))))
+ (&/V $Done (&/T [(&/T [file-name line-num column-num]) text]))
+ (&/V $Yes (&/T [(&/T [(&/T [file-name line-num column-num]) text])
+ (&/T [(&/T [file-name line-num column-num*]) line])]))))
(&/V $No (str "[Reader Error] Text failed: " text))))))
(defn from [^String name ^String source-code]
(let [lines (string/split-lines source-code)
indexed-lines (map (fn [line line-num]
- (&/T (&/T name (inc line-num) 0)
- line))
+ (&/T [(&/T [name (inc line-num) 0])
+ line]))
lines
(range (count lines)))]
(reduce (fn [tail head] (&/Cons$ head tail))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 0655aa8b2..33c012806 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -27,42 +27,42 @@
(def empty-env &/Nil$)
(defn Data$ [name params]
- (&/V &/$DataT (&/T 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)))
+ (&/V &/$LambdaT (&/T [in out])))
(defn App$ [fun arg]
- (&/V &/$AppT (&/T fun arg)))
+ (&/V &/$AppT (&/T [fun arg])))
(defn Prod$ [left right]
- (&/V &/$ProdT (&/T left right)))
+ (&/V &/$ProdT (&/T [left right])))
(defn Sum$ [left right]
- (&/V &/$SumT (&/T left right)))
+ (&/V &/$SumT (&/T [left right])))
(defn Univ$ [env body]
- (&/V &/$UnivQ (&/T env body)))
+ (&/V &/$UnivQ (&/T [env body])))
(defn Ex$ [env body]
- (&/V &/$ExQ (&/T env body)))
+ (&/V &/$ExQ (&/T [env body])))
(defn Named$ [name type]
- (&/V &/$NamedT (&/T name type)))
+ (&/V &/$NamedT (&/T [name type])))
(def $Void (&/V &/$VoidT nil))
(def Unit (&/V &/$UnitT nil))
-(def Bool (Named$ (&/T "lux" "Bool") (Data$ "java.lang.Boolean" &/Nil$)))
-(def Int (Named$ (&/T "lux" "Int") (Data$ "java.lang.Long" &/Nil$)))
-(def Real (Named$ (&/T "lux" "Real") (Data$ "java.lang.Double" &/Nil$)))
-(def Char (Named$ (&/T "lux" "Char") (Data$ "java.lang.Character" &/Nil$)))
-(def Text (Named$ (&/T "lux" "Text") (Data$ "java.lang.String" &/Nil$)))
-(def Ident (Named$ (&/T "lux" "Ident") (Prod$ Text Text)))
+(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 IO
- (Named$ (&/T "lux/data" "IO")
+ (Named$ (&/T ["lux/data" "IO"])
(Univ$ empty-env
(Lambda$ Unit (Bound$ 1)))))
(def List
- (Named$ (&/T "lux" "List")
+ (Named$ (&/T ["lux" "List"])
(Univ$ empty-env
(Sum$
;; lux;Nil
@@ -73,7 +73,7 @@
(Bound$ 1)))))))
(def Maybe
- (Named$ (&/T "lux" "Maybe")
+ (Named$ (&/T ["lux" "Maybe"])
(Univ$ empty-env
(Sum$
;; lux;None
@@ -83,7 +83,7 @@
)))
(def Type
- (Named$ (&/T "lux" "Type")
+ (Named$ (&/T ["lux" "Type"])
(let [Type (App$ (Bound$ 0) (Bound$ 1))
TypeList (App$ List Type)
TypePair (Prod$ Type Type)]
@@ -130,7 +130,7 @@
$Void))))
(def DefMetaValue
- (Named$ (&/T "lux" "DefMetaValue")
+ (Named$ (&/T ["lux" "DefMetaValue"])
(let [DefMetaValue (App$ (Bound$ 0) (Bound$ 1))]
(App$ (Univ$ empty-env
(Sum$
@@ -160,7 +160,7 @@
$Void))))
(def DefMeta
- (Named$ (&/T "lux" "DefMeta")
+ (Named$ (&/T ["lux" "DefMeta"])
(App$ List (Prod$ Ident DefMetaValue))))
(def Macro)
@@ -250,12 +250,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 (&/V &/$Some ?type**)]))))
))))
(->> state (&/get$ &/$type-vars) (&/get$ &/$mappings)))]
(fn [state]
@@ -321,19 +321,19 @@
(|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
(&/$AppT ?left ?right)
(|let [[?fun-type ?args] (unravel-app ?left)]
- (&/T ?fun-type (&/|++ ?args (&/|list ?right))))
+ (&/T [?fun-type (&/|++ ?args (&/|list ?right))]))
_
- (&/T fun-type &/Nil$)))
+ (&/T [fun-type &/Nil$])))
(do-template [<tag> <flatten> <at> <desc>]
(do (defn <flatten> [type]
@@ -352,7 +352,7 @@
(<at> tag ?type)
(<tag> ?left ?right)
- (|case (&/T tag ?right)
+ (|case (&/T [tag ?right])
[0 _] (return ?left)
[1 (<tag> ?left* _)] (return ?left*)
[1 _] (return ?right)
@@ -487,7 +487,7 @@
)))
(defn ^:private fp-put [k v fixpoints]
- (&/Cons$ (&/T k v) fixpoints))
+ (&/Cons$ (&/T [k v]) fixpoints))
(defn ^:private show-type+ [type]
(|case type
@@ -584,12 +584,12 @@
(defn ^:private check* [class-loader fixpoints invariant?? expected actual]
(if (clojure.lang.Util/identical expected actual)
- (return (&/T fixpoints nil))
+ (return (&/T [fixpoints nil]))
(&/with-attempt
(|case [expected actual]
[(&/$VarT ?eid) (&/$VarT ?aid)]
(if (.equals ^Object ?eid ?aid)
- (return (&/T fixpoints nil))
+ (return (&/T [fixpoints nil]))
(|do [ebound (fn [state]
(|case ((deref ?eid) state)
(&/$Right state* ebound)
@@ -607,7 +607,7 @@
(|case [ebound abound]
[(&/$None _) (&/$None _)]
(|do [_ (set-var ?eid actual)]
- (return (&/T fixpoints nil)))
+ (return (&/T [fixpoints nil])))
[(&/$Some etype) (&/$None _)]
(check* class-loader fixpoints invariant?? etype actual)
@@ -622,7 +622,7 @@
(fn [state]
(|case ((set-var ?id actual) state)
(&/$Right state* _)
- (return* state* (&/T fixpoints nil))
+ (return* state* (&/T [fixpoints nil]))
(&/$Left _)
((|do [bound (deref ?id)]
@@ -633,7 +633,7 @@
(fn [state]
(|case ((set-var ?id expected) state)
(&/$Right state* _)
- (return* state* (&/T fixpoints nil))
+ (return* state* (&/T [fixpoints nil]))
(&/$Left _)
((|do [bound (deref ?id)]
@@ -658,7 +658,7 @@
e* (apply-type F2 A1)
a* (apply-type F2 A2)
[fixpoints** _] (check* class-loader fixpoints* invariant?? e* a*)]
- (return (&/T fixpoints** nil)))
+ (return (&/T [fixpoints** nil])))
state)))
[(&/$AppT F1 A1) (&/$AppT (&/$VarT ?id) A2)]
@@ -674,11 +674,11 @@
e* (apply-type F1 A1)
a* (apply-type F1 A2)
[fixpoints** _] (check* class-loader fixpoints* invariant?? e* a*)]
- (return (&/T fixpoints** nil)))
+ (return (&/T [fixpoints** nil])))
state)))
[(&/$AppT F A) _]
- (let [fp-pair (&/T expected actual)
+ (let [fp-pair (&/T [expected actual])
_ (when (> (&/|length fixpoints) 40)
(println 'FIXPOINTS (->> (&/|keys fixpoints)
(&/|map (fn [pair]
@@ -691,7 +691,7 @@
(|case (fp-get fp-pair fixpoints)
(&/$Some ?)
(if ?
- (return (&/T fixpoints nil))
+ (return (&/T [fixpoints nil]))
(check-error "" expected actual))
(&/$None)
@@ -741,10 +741,10 @@
a!data)
[(&/$VoidT) (&/$VoidT)]
- (return (&/T fixpoints nil))
+ (return (&/T [fixpoints nil]))
[(&/$UnitT) (&/$UnitT)]
- (return (&/T fixpoints nil))
+ (return (&/T [fixpoints nil]))
[(&/$LambdaT eI eO) (&/$LambdaT aI aO)]
(|do [[fixpoints* _] (check* class-loader fixpoints invariant?? aI eI)]
@@ -760,7 +760,7 @@
[(&/$ExT e!id) (&/$ExT a!id)]
(if (.equals ^Object e!id a!id)
- (return (&/T fixpoints nil))
+ (return (&/T [fixpoints nil]))
(check-error "" expected actual))
[(&/$NamedT ?ename ?etype) _]
diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj
index b782f6c44..b06895945 100644
--- a/src/lux/type/host.clj
+++ b/src/lux/type/host.clj
@@ -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)))
@@ -81,8 +81,8 @@
(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$))
+ (reduce (fn [inner _] (&/V &/$DataT (&/T [array-data-tag (&/|list inner)])))
+ (&/V &/$DataT (&/T [base &/Nil$]))
(range (count (or arr-obrackets arr-pbrackets "")))))
))))
@@ -93,7 +93,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 (&/V &/$DataT (&/T [array-data-tag (&/|list inner-type)]))))
(instance? ParameterizedType refl-type)
(|do [:let [refl-type* ^ParameterizedType refl-type]
@@ -101,8 +101,8 @@
.getActualTypeArguments
seq &/->list
(&/map% (partial instance-param existential matchings)))]
- (return (&/V &/$DataT (&/T (->> refl-type* ^Class (.getRawType) .getName)
- params*))))
+ (return (&/V &/$DataT (&/T [(->> refl-type* ^Class (.getRawType) .getName)
+ params*]))))
(instance? TypeVariable refl-type)
(let [gvar (.getName ^TypeVariable refl-type)]
@@ -123,15 +123,15 @@
(|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 (&/V &/$DataT (&/T [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 (&/V &/$DataT (&/T [type-name
+ params*])))))
(&/$GenericTypeVar var-name)
(if-let [m-type (&/|get var-name matchings)]
@@ -164,24 +164,24 @@
super-params
(->> sub .getTypeParameters seq &/->list)
params)]
- (return (&/T super params*)))
+ (return (&/T [super params*])))
(let [super* (.getGenericSuperclass sub)]
(cond (instance? Class super*)
- (return (&/T super* (&/|list)))
+ (return (&/T [super* (&/|list)]))
(instance? ParameterizedType super*)
(|do [params* (translate-params existential
(->> ^ParameterizedType super* .getActualTypeArguments seq &/->list)
(->> sub .getTypeParameters seq &/->list)
params)]
- (return (&/T super params*)))
+ (return (&/T [super params*])))
:else
(assert false (prn-str super* (class super*) [sub super])))))))
(defn ^:private raise [existential lineage class params]
"(-> (List Class) Class (List Type) (Lux (, Class (List Type))))"
- (&/fold% (partial raise* existential) (&/T class params) lineage))
+ (&/fold% (partial raise* existential) (&/T [class params]) lineage))
;; [Exports]
(defn ->super-type [existential class-loader super-class sub-class sub-params]
@@ -191,7 +191,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 (&/V &/$DataT (&/T [(.getName sub-class*) sub-params*])))))
(fail (str "[Type Error] Classes don't have a subtyping relationship: " sub-class " </= " super-class)))))
(defn as-obj [class]
@@ -215,16 +215,16 @@
(|let [[e!name e!params] expected
[a!name a!params] actual]
(try (cond (= "java.lang.Object" e!name)
- (return (&/T fixpoints nil))
+ (return (&/T [fixpoints nil]))
(= null-data-tag a!name)
(if (not (primitive-type? e!name))
- (return (&/T fixpoints nil))
+ (return (&/T [fixpoints nil]))
(check-error "" (&/V &/$DataT expected) (&/V &/$DataT actual)))
(= null-data-tag e!name)
(if (= null-data-tag a!name)
- (return (&/T fixpoints nil))
+ (return (&/T [fixpoints nil]))
(check-error "" (&/V &/$DataT expected) (&/V &/$DataT actual)))
(and (= array-data-tag e!name)
@@ -237,7 +237,7 @@
(cond (.equals ^Object e!name a!name)
(if (= (&/|length e!params) (&/|length a!params))
(|do [_ (&/map2% check e!params a!params)]
- (return (&/T fixpoints nil)))
+ (return (&/T [fixpoints nil])))
(fail (str "[Type Error] Amounts of generic parameters don't match: " e!name "(" (&/|length e!params) ")" " vs " a!name "(" (&/|length a!params) ")")))
(not invariant??)
@@ -253,7 +253,7 @@
(defn gtype->gclass [gtype]
"(-> GenericType GenericClass)"
(cond (instance? Class gtype)
- (&/V &/$GenericClass (&/T (.getName ^Class gtype) &/Nil$))
+ (&/V &/$GenericClass (&/T [(.getName ^Class gtype) &/Nil$]))
(instance? GenericArrayType gtype)
(&/V &/$GenericArray (gtype->gclass (.getGenericComponentType ^GenericArrayType gtype)))
@@ -264,7 +264,7 @@
.getActualTypeArguments
seq &/->list
(&/|map gtype->gclass))]
- (&/V &/$GenericClass (&/T type-name type-params)))
+ (&/V &/$GenericClass (&/T [type-name type-params])))
(instance? TypeVariable gtype)
(&/V &/$GenericTypeVar (.getName ^TypeVariable gtype))