aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser.clj2
-rw-r--r--src/lux/analyser/case.clj116
-rw-r--r--src/lux/analyser/host.clj48
-rw-r--r--src/lux/analyser/lux.clj42
-rw-r--r--src/lux/base.clj26
-rw-r--r--src/lux/compiler/base.clj2
-rw-r--r--src/lux/compiler/host.clj20
-rw-r--r--src/lux/compiler/type.clj32
-rw-r--r--src/lux/host.clj8
-rw-r--r--src/lux/type.clj356
10 files changed, 335 insertions, 317 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 0ad6553bf..f8dd13bd6 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -529,7 +529,7 @@
(fn [?var]
(|do [[?output-term ?output-type] (&&/analyse-1 analyser ?var syntax)]
(|case [?var ?output-type]
- [("lux;VarT" ?e-id) ("lux;VarT" ?a-id)]
+ [(&/$VarT ?e-id) (&/$VarT ?a-id)]
(if (= ?e-id ?a-id)
(|do [?output-type* (&type/deref ?e-id)]
(return (&/T ?output-term ?output-type*)))
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 0bbbde2d7..aaf11ff15 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -21,12 +21,12 @@
(defn ^:private resolve-type [type]
(|case type
- ("lux;VarT" ?id)
+ (&/$VarT ?id)
(|do [type* (&/try-all% (&/|list (&type/deref ?id)
(fail "##9##")))]
(resolve-type type*))
- ("lux;AllT" _aenv _aname _aarg _abody)
+ (&/$AllT _aenv _aname _aarg _abody)
;; (&type/actual-type _abody)
(|do [$var &type/existential
=type (&type/apply-type type $var)]
@@ -42,64 +42,64 @@
(defn adjust-type* [up type]
"(-> (List (, (Maybe (Env Text Type)) Text Text Type)) Type (Lux Type))"
(|case type
- ("lux;AllT" _aenv _aname _aarg _abody)
+ (&/$AllT _aenv _aname _aarg _abody)
(&type/with-var
(fn [$var]
(|do [=type (&type/apply-type type $var)]
(adjust-type* (&/|cons (&/T _aenv _aname _aarg $var) up) =type))))
- ("lux;TupleT" ?members)
- (|do [("lux;TupleT" ?members*) (&/fold% (fn [_abody ena]
- (|let [[_aenv _aname _aarg ["lux;VarT" _avar]] ena]
- (|do [_ (&type/set-var _avar (&/V "lux;BoundT" _aarg))]
- (&type/clean* _avar _abody))))
- type
- up)]
- (return (&/V "lux;TupleT" (&/|map (fn [v]
- (&/fold (fn [_abody ena]
- (|let [[_aenv _aname _aarg _avar] ena]
- (&/V "lux;AllT" (&/T _aenv _aname _aarg _abody))))
- v
- up))
- ?members*))))
-
- ("lux;RecordT" ?fields)
- (|do [("lux;RecordT" ?fields*) (&/fold% (fn [_abody ena]
- (|let [[_aenv _aname _aarg ["lux;VarT" _avar]] ena]
- (|do [_ (&type/set-var _avar (&/V "lux;BoundT" _aarg))]
- (&type/clean* _avar _abody))))
- type
- up)]
- (return (&/V "lux;RecordT" (&/|map (fn [kv]
- (|let [[k v] kv]
- (&/T k (&/fold (fn [_abody ena]
- (|let [[_aenv _aname _aarg _avar] ena]
- (&/V "lux;AllT" (&/T _aenv _aname _aarg _abody))))
- v
- up))))
- ?fields*))))
-
- ("lux;VariantT" ?cases)
- (|do [("lux;VariantT" ?cases*) (&/fold% (fn [_abody ena]
- (|let [[_aenv _aname _aarg ["lux;VarT" _avar]] ena]
- (|do [_ (&type/set-var _avar (&/V "lux;BoundT" _aarg))]
- (&type/clean* _avar _abody))))
- type
- up)]
- (return (&/V "lux;VariantT" (&/|map (fn [kv]
- (|let [[k v] kv]
- (&/T k (&/fold (fn [_abody ena]
- (|let [[_aenv _aname _aarg _avar] ena]
- (&/V "lux;AllT" (&/T _aenv _aname _aarg _abody))))
- v
- up))))
- ?cases*))))
-
- ("lux;AppT" ?tfun ?targ)
+ (&/$TupleT ?members)
+ (|do [(&/$TupleT ?members*) (&/fold% (fn [_abody ena]
+ (|let [[_aenv _aname _aarg (&/$VarT _avar)] ena]
+ (|do [_ (&type/set-var _avar (&/V &/$BoundT _aarg))]
+ (&type/clean* _avar _abody))))
+ type
+ up)]
+ (return (&/V &/$TupleT (&/|map (fn [v]
+ (&/fold (fn [_abody ena]
+ (|let [[_aenv _aname _aarg _avar] ena]
+ (&/V &/$AllT (&/T _aenv _aname _aarg _abody))))
+ v
+ up))
+ ?members*))))
+
+ (&/$RecordT ?fields)
+ (|do [(&/$RecordT ?fields*) (&/fold% (fn [_abody ena]
+ (|let [[_aenv _aname _aarg (&/$VarT _avar)] ena]
+ (|do [_ (&type/set-var _avar (&/V &/$BoundT _aarg))]
+ (&type/clean* _avar _abody))))
+ type
+ up)]
+ (return (&/V &/$RecordT (&/|map (fn [kv]
+ (|let [[k v] kv]
+ (&/T k (&/fold (fn [_abody ena]
+ (|let [[_aenv _aname _aarg _avar] ena]
+ (&/V &/$AllT (&/T _aenv _aname _aarg _abody))))
+ v
+ up))))
+ ?fields*))))
+
+ (&/$VariantT ?cases)
+ (|do [(&/$VariantT ?cases*) (&/fold% (fn [_abody ena]
+ (|let [[_aenv _aname _aarg (&/$VarT _avar)] ena]
+ (|do [_ (&type/set-var _avar (&/V &/$BoundT _aarg))]
+ (&type/clean* _avar _abody))))
+ type
+ up)]
+ (return (&/V &/$VariantT (&/|map (fn [kv]
+ (|let [[k v] kv]
+ (&/T k (&/fold (fn [_abody ena]
+ (|let [[_aenv _aname _aarg _avar] ena]
+ (&/V &/$AllT (&/T _aenv _aname _aarg _abody))))
+ v
+ up))))
+ ?cases*))))
+
+ (&/$AppT ?tfun ?targ)
(|do [=type (&type/apply-type ?tfun ?targ)]
(adjust-type* up =type))
- ("lux;VarT" ?id)
+ (&/$VarT ?id)
(|do [type* (&/try-all% (&/|list (&type/deref ?id)
(fail "##9##")))]
(adjust-type* up type*))
@@ -153,7 +153,7 @@
(|do [value-type* (adjust-type value-type)]
(do ;; (prn 'PM/TUPLE-1 (&type/show-type value-type*))
(|case value-type*
- ("lux;TupleT" ?member-types)
+ (&/$TupleT ?member-types)
(do ;; (prn 'PM/TUPLE-2 (&/|length ?member-types) (&/|length ?members))
(if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members)))
(fail (str "[Pattern-matching Error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]"))
@@ -176,7 +176,7 @@
;; value-type* (resolve-type value-type)
]
(|case value-type*
- ("lux;RecordT" ?slot-types)
+ (&/$RecordT ?slot-types)
(if (not (.equals ^Object (&/|length ?slot-types) (&/|length ?slots)))
(fail (str "[Analyser Error] Pattern-matching mismatch. Require record[" (&/|length ?slot-types) "]. Given record[" (&/|length ?slots) "]"))
(|do [[=tests =kont] (&/fold (fn [kont* slot]
@@ -207,7 +207,7 @@
(return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont)))
(&/$FormS (&/$Cons (&/$Meta _ (&/$TagS ?ident))
- ?values))
+ ?values))
(|do [=tag (&&/resolved-ident ?ident)
value-type* (adjust-type value-type)
case-type (&type/variant-case =tag value-type*)
@@ -341,7 +341,7 @@
(return true)
(|do [value-type* (resolve-type value-type)]
(|case value-type*
- ("lux;TupleT" ?members)
+ (&/$TupleT ?members)
(|do [totals (&/map2% (fn [sub-struct ?member]
(check-totality ?member sub-struct))
?structs ?members)]
@@ -355,7 +355,7 @@
(return true)
(|do [value-type* (resolve-type value-type)]
(|case value-type*
- ("lux;RecordT" ?fields)
+ (&/$RecordT ?fields)
(|do [totals (&/map% (fn [field]
(|let [[?tk ?tv] field]
(if-let [sub-struct (&/|get ?tk ?structs)]
@@ -372,7 +372,7 @@
(return true)
(|do [value-type* (resolve-type value-type)]
(|case value-type*
- ("lux;VariantT" ?cases)
+ (&/$VariantT ?cases)
(|do [totals (&/map% (fn [case]
(|let [[?tk ?tv] case]
(if-let [sub-struct (&/|get ?tk ?structs)]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 06cb5ebfc..ec8b8b5db 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -37,7 +37,7 @@
(defn ^:private ensure-object [token]
"(-> Analysis (Lux (,)))"
(|case token
- [_ ("lux;DataT" _)]
+ [_ (&/$DataT _)]
(return nil)
_
@@ -46,16 +46,16 @@
(defn ^:private as-object [type]
"(-> Type Type)"
(|case type
- ("lux;DataT" class)
- (&/V "lux;DataT" (&type/as-obj class))
+ (&/$DataT class)
+ (&/V &/$DataT (&type/as-obj class))
_
type))
;; [Resources]
(do-template [<name> <output-tag> <input-class> <output-class>]
- (let [input-type (&/V "lux;DataT" <input-class>)
- output-type (&/V "lux;DataT" <output-class>)]
+ (let [input-type (&/V &/$DataT <input-class>)
+ output-type (&/V &/$DataT <output-class>)]
(defn <name> [analyse exo-type ?x ?y]
(|do [=x (&&/analyse-1 analyse input-type ?x)
=y (&&/analyse-1 analyse input-type ?y)
@@ -140,10 +140,10 @@
=classes (&/map% extract-text ?classes)
=return (&host/lookup-static-method class-loader ?class ?method =classes)
;; :let [_ (matchv ::M/objects [=return]
- ;; [["lux;DataT" _return-class]]
+ ;; [[&/$DataT _return-class]]
;; (prn 'analyse-jvm-invokestatic ?class ?method _return-class))]
=args (&/map2% (fn [_class _arg]
- (&&/analyse-1 analyse (&/V "lux;DataT" _class) _arg))
+ (&&/analyse-1 analyse (&/V &/$DataT _class) _arg))
=classes
?args)
:let [output-type =return]
@@ -162,8 +162,8 @@
(|do [class-loader &/loader
=classes (&/map% extract-text ?classes)
=return (&host/lookup-virtual-method class-loader ?class ?method =classes)
- =object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object)
- =args (&/map2% (fn [?c ?o] (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o))
+ =object (&&/analyse-1 analyse (&/V &/$DataT ?class) ?object)
+ =args (&/map2% (fn [?c ?o] (&&/analyse-1 analyse (&/V &/$DataT ?c) ?o))
=classes ?args)
:let [output-type =return]
_ (&type/check exo-type output-type)]
@@ -179,9 +179,9 @@
=return (if (= "<init>" ?method)
(return &type/Unit)
(&host/lookup-virtual-method class-loader ?class ?method =classes))
- =object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object)
+ =object (&&/analyse-1 analyse (&/V &/$DataT ?class) ?object)
=args (&/map2% (fn [?c ?o]
- (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o))
+ (&&/analyse-1 analyse (&/V &/$DataT ?c) ?o))
=classes ?args)
:let [output-type =return]
_ (&type/check exo-type output-type)]
@@ -195,19 +195,19 @@
(return (&/|list (&/T (&/V "jvm-null?" =object) output-type)))))
(defn analyse-jvm-null [analyse exo-type]
- (|do [:let [output-type (&/V "lux;DataT" "null")]
+ (|do [:let [output-type (&/V &/$DataT "null")]
_ (&type/check exo-type output-type)]
(return (&/|list (&/T (&/V "jvm-null" nil) output-type)))))
(defn analyse-jvm-new [analyse exo-type ?class ?classes ?args]
(|do [=classes (&/map% extract-text ?classes)
=args (&/map% (partial analyse-1+ analyse) ?args)
- :let [output-type (&/V "lux;DataT" ?class)]
+ :let [output-type (&/V &/$DataT ?class)]
_ (&type/check exo-type output-type)]
(return (&/|list (&/T (&/V "jvm-new" (&/T ?class =classes =args)) output-type)))))
(defn analyse-jvm-new-array [analyse ?class ?length]
- (return (&/|list (&/T (&/V "jvm-new-array" (&/T ?class ?length)) (&/V "array" (&/T (&/V "lux;DataT" ?class)
+ (return (&/|list (&/T (&/V "jvm-new-array" (&/T ?class ?length)) (&/V "array" (&/T (&/V &/$DataT ?class)
(&/V &/$Nil nil)))))))
(defn analyse-jvm-aastore [analyse ?array ?idx ?elem]
@@ -309,11 +309,11 @@
=method-body (&/with-scope (str ?name "_" ?idx)
(&/fold (fn [body* input*]
(|let [[iname itype] input*]
- (&&env/with-local iname (&/V "lux;DataT" (as-otype itype))
+ (&&env/with-local iname (&/V &/$DataT (as-otype itype))
body*)))
(if (= "void" ?method-output)
(analyse-1+ analyse ?method-body)
- (&&/analyse-1 analyse (&/V "lux;DataT" (as-otype ?method-output)) ?method-body))
+ (&&/analyse-1 analyse (&/V &/$DataT (as-otype ?method-output)) ?method-body))
(&/|reverse (if (:static? =method-modifiers)
=method-inputs
(&/|cons (&/T ";this" ?super-class)
@@ -356,7 +356,7 @@
(|do [:let [[?catches ?finally] ?catches+?finally]
=body (&&/analyse-1 analyse exo-type ?body)
=catches (&/map% (fn [[?ex-class ?ex-arg ?catch-body]]
- (|do [=catch-body (&&env/with-local ?ex-arg (&/V "lux;DataT" ?ex-class)
+ (|do [=catch-body (&&env/with-local ?ex-arg (&/V &/$DataT ?ex-class)
(&&/analyse-1 analyse exo-type ?catch-body))
idx &&env/next-local-idx]
(return (&/T ?ex-class idx =catch-body))))
@@ -370,7 +370,7 @@
(defn analyse-jvm-throw [analyse exo-type ?ex]
(|do [=ex (analyse-1+ analyse ?ex)
:let [[_obj _type] =ex]
- _ (&type/check (&/V "lux;DataT" "java.lang.Throwable") _type)]
+ _ (&type/check (&/V &/$DataT "java.lang.Throwable") _type)]
(return (&/|list (&/T (&/V "jvm-throw" =ex) &type/$Void)))))
(do-template [<name> <tag>]
@@ -386,9 +386,9 @@
)
(do-template [<name> <tag> <from-class> <to-class>]
- (let [output-type (&/V "lux;DataT" <to-class>)]
+ (let [output-type (&/V &/$DataT <to-class>)]
(defn <name> [analyse exo-type ?value]
- (|do [=value (&&/analyse-1 analyse (&/V "lux;DataT" <from-class>) ?value)
+ (|do [=value (&&/analyse-1 analyse (&/V &/$DataT <from-class>) ?value)
_ (&type/check exo-type output-type)]
(return (&/|list (&/T (&/V <tag> =value) output-type))))))
@@ -413,9 +413,9 @@
)
(do-template [<name> <tag> <from-class> <to-class>]
- (let [output-type (&/V "lux;DataT" <to-class>)]
+ (let [output-type (&/V &/$DataT <to-class>)]
(defn <name> [analyse exo-type ?value]
- (|do [=value (&&/analyse-1 analyse (&/V "lux;DataT" <from-class>) ?value)
+ (|do [=value (&&/analyse-1 analyse (&/V &/$DataT <from-class>) ?value)
_ (&type/check exo-type output-type)]
(return (&/|list (&/T (&/V <tag> =value) output-type))))))
@@ -436,7 +436,7 @@
(defn analyse-jvm-program [analyse compile-token ?args ?body]
(|do [=body (&/with-scope ""
- (&&env/with-local ?args (&/V "lux;AppT" (&/T &type/List &type/Text))
- (&&/analyse-1 analyse (&/V "lux;AppT" (&/T &type/IO &type/Unit)) ?body)))
+ (&&env/with-local ?args (&/V &/$AppT (&/T &type/List &type/Text))
+ (&&/analyse-1 analyse (&/V &/$AppT (&/T &type/IO &type/Unit)) ?body)))
_ (compile-token (&/V "jvm-program" =body))]
(return (&/|list))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index ac7e56ef4..6503fe2ea 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -37,14 +37,14 @@
(defn analyse-tuple [analyse exo-type ?elems]
(|do [exo-type* (&type/actual-type exo-type)]
(|case exo-type*
- ("lux;TupleT" ?members)
+ (&/$TupleT ?members)
(|do [=elems (&/map2% (fn [elem-t elem]
(&&/analyse-1 analyse elem-t elem))
?members ?elems)]
(return (&/|list (&/T (&/V "tuple" =elems)
exo-type))))
- ("lux;AllT" _)
+ (&/$AllT _)
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)]
@@ -73,7 +73,7 @@
(defn analyse-variant [analyse exo-type ident ?values]
(|do [exo-type* (|case exo-type
- ("lux;VarT" ?id)
+ (&/$VarT ?id)
(&/try-all% (&/|list (|do [exo-type* (&type/deref ?id)]
(&type/actual-type exo-type*))
(|do [_ (&type/set-var ?id &type/Type)]
@@ -82,7 +82,7 @@
_
(&type/actual-type exo-type))]
(|case exo-type*
- ("lux;VariantT" ?cases)
+ (&/$VariantT ?cases)
(|do [?tag (&&/resolved-ident ident)]
(if-let [vtype (&/|get ?tag ?cases)]
(|do [=value (analyse-variant-body analyse vtype ?values)]
@@ -90,7 +90,7 @@
exo-type))))
(fail (str "[Analyser Error] There is no case " ?tag " for variant type " (&type/show-type exo-type*)))))
- ("lux;AllT" _)
+ (&/$AllT _)
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)]
@@ -101,11 +101,11 @@
(defn analyse-record [analyse exo-type ?elems]
(|do [exo-type* (|case exo-type
- ("lux;VarT" ?id)
+ (&/$VarT ?id)
(|do [exo-type* (&type/deref ?id)]
(&type/actual-type exo-type*))
- ("lux;AllT" _)
+ (&/$AllT _)
(|do [$var &type/existential
=type (&type/apply-type exo-type $var)]
(&type/actual-type =type))
@@ -117,7 +117,7 @@
_
(&type/actual-type exo-type))
types (|case exo-type*
- ("lux;RecordT" ?table)
+ (&/$RecordT ?table)
(return ?table)
_
@@ -139,7 +139,7 @@
_
(fail "[Analyser Error] Wrong syntax for records. Odd elements must be tags.")))
?elems)]
- (return (&/|list (&/T (&/V "record" =slots) (&/V "lux;RecordT" exo-type))))))
+ (return (&/|list (&/T (&/V "record" =slots) (&/V &/$RecordT exo-type))))))
(defn ^:private analyse-global [analyse exo-type module name]
(|do [[[r-module r-name] $def] (&&module/find-def module name)
@@ -238,7 +238,7 @@
(&/$Cons ?arg ?args*)
(|do [?fun-type* (&type/actual-type fun-type)]
(|case ?fun-type*
- ("lux;AllT" _aenv _aname _aarg _abody)
+ (&/$AllT _aenv _aname _aarg _abody)
;; (|do [$var &type/existential
;; type* (&type/apply-type ?fun-type* $var)]
;; (analyse-apply* analyse exo-type type* ?args))
@@ -247,21 +247,21 @@
(|do [type* (&type/apply-type ?fun-type* $var)
[=output-t =args] (analyse-apply* analyse exo-type type* ?args)]
(|case $var
- ("lux;VarT" ?id)
+ (&/$VarT ?id)
(|do [? (&type/bound? ?id)
type** (if ?
(&type/clean $var =output-t)
- (|do [_ (&type/set-var ?id (&/V "lux;BoundT" _aarg))]
+ (|do [_ (&type/set-var ?id (&/V &/$BoundT _aarg))]
(&type/clean $var =output-t)))]
(return (&/T type** =args)))
))))
- ("lux;LambdaT" ?input-t ?output-t)
+ (&/$LambdaT ?input-t ?output-t)
(|do [[=output-t =args] (analyse-apply* analyse exo-type ?output-t ?args*)
=arg (&&/analyse-1 analyse ?input-t ?arg)]
(return (&/T =output-t (&/|cons =arg =args))))
- ;; [["lux;VarT" ?id-t]]
+ ;; [[&/$VarT ?id-t]]
;; (|do [ (&type/deref ?id-t)])
_
@@ -314,7 +314,7 @@
(defn analyse-lambda* [analyse exo-type ?self ?arg ?body]
(|do [exo-type* (&type/actual-type exo-type)]
(|case exo-type
- ("lux;AllT" _)
+ (&/$AllT _)
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)]
@@ -323,7 +323,7 @@
;; exo-type** (&type/apply-type exo-type* $var)]
;; (analyse-lambda* analyse exo-type** ?self ?arg ?body))
- ("lux;LambdaT" ?arg-t ?return-t)
+ (&/$LambdaT ?arg-t ?return-t)
(|do [[=scope =captured =body] (&&lambda/with-lambda ?self exo-type*
?arg ?arg-t
(&&/analyse-1 analyse ?return-t ?body))]
@@ -335,26 +335,26 @@
(defn analyse-lambda** [analyse exo-type ?self ?arg ?body]
(|case exo-type
- ("lux;AllT" _env _self _arg _body)
+ (&/$AllT _env _self _arg _body)
(&type/with-var
(fn [$var]
(|do [exo-type* (&type/apply-type exo-type $var)
[_expr _] (analyse-lambda** analyse exo-type* ?self ?arg ?body)]
(|case $var
- ("lux;VarT" ?id)
+ (&/$VarT ?id)
(|do [? (&type/bound? ?id)]
(if ?
(|do [dtype (&type/deref ?id)
;; dtype* (&type/actual-type dtype)
]
(|case dtype
- ("lux;BoundT" ?vname)
+ (&/$BoundT ?vname)
(return (&/T _expr exo-type))
- ("lux;ExT" _)
+ (&/$ExT _)
(return (&/T _expr exo-type))
- ("lux;VarT" ?_id)
+ (&/$VarT ?_id)
(|do [?? (&type/bound? ?_id)]
;; (return (&/T _expr exo-type))
(if ??
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 7ec9e3029..532f56695 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -12,17 +12,22 @@
clojure.core.match.array))
;; [Tags]
+;; List
(def $Nil "lux;Nil")
(def $Cons "lux;Cons")
+;; Maybe
(def $None "lux;None")
(def $Some "lux;Some")
+;; Meta
(def $Meta "lux;Meta")
+;; Either
(def $Left "lux;Left")
(def $Right "lux;Right")
+;; AST
(def $BoolS "lux;BoolS")
(def $IntS "lux;IntS")
(def $RealS "lux;RealS")
@@ -34,6 +39,18 @@
(def $TupleS "lux;TupleS")
(def $RecordS "lux;RecordS")
+;; Type
+(def $DataT "lux;DataT")
+(def $TupleT "lux;TupleT")
+(def $VariantT "lux;VariantT")
+(def $RecordT "lux;RecordT")
+(def $LambdaT "lux;LambdaT")
+(def $VarT "lux;VarT")
+(def $ExT "lux;ExT")
+(def $BoundT "lux;BoundT")
+(def $AppT "lux;AppT")
+(def $AllT "lux;AllT")
+
;; [Fields]
;; Binding
(def $COUNTER 0)
@@ -156,8 +173,9 @@
(V $Cons (T (T slot value) table*))
(V $Cons (T (T k v) (|put slot value table*))))
- _
- (assert false (prn-str '|put (aget table 0)))))
+ ;; _
+ ;; (assert false (prn-str '|put (aget table 0)))
+ ))
(defn |remove [slot table]
(|case table
@@ -541,7 +559,7 @@
;; "lux;eval?"
false
;; "lux;expected"
- (V "lux;VariantT" (|list))
+ (V $VariantT (|list))
;; "lux;host"
(host nil)
;; "lux;modules"
@@ -677,7 +695,7 @@
_
output))))
-(defn with-cursor [cursor body]
+(defn with-cursor [^objects cursor body]
"(All [a] (-> Cursor (Lux a)))"
(if (= "" (aget cursor 0))
body
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index 74e5625b3..03fae9fec 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -50,7 +50,7 @@
(write-file (str module-dir "/" name ".class") data)))
;; [Exports]
-(defn load-class! [^ClassLoader loader name]
+(defn ^Class load-class! [^ClassLoader loader name]
;; (prn 'load-class! name)
(.loadClass loader name))
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 02e9e1430..78b9e72f6 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -52,34 +52,34 @@
char-class "java.lang.Character"]
(defn prepare-return! [^MethodVisitor *writer* *type*]
(|case *type*
- ("lux;TupleT" (&/$Nil))
+ (&/$TupleT (&/$Nil))
(.visitInsn *writer* Opcodes/ACONST_NULL)
- ("lux;DataT" "boolean")
+ (&/$DataT "boolean")
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class boolean-class) "valueOf" (str "(Z)" (&host/->type-signature boolean-class)))
- ("lux;DataT" "byte")
+ (&/$DataT "byte")
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class byte-class) "valueOf" (str "(B)" (&host/->type-signature byte-class)))
- ("lux;DataT" "short")
+ (&/$DataT "short")
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class short-class) "valueOf" (str "(S)" (&host/->type-signature short-class)))
- ("lux;DataT" "int")
+ (&/$DataT "int")
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class int-class) "valueOf" (str "(I)" (&host/->type-signature int-class)))
- ("lux;DataT" "long")
+ (&/$DataT "long")
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class long-class) "valueOf" (str "(J)" (&host/->type-signature long-class)))
- ("lux;DataT" "float")
+ (&/$DataT "float")
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class float-class) "valueOf" (str "(F)" (&host/->type-signature float-class)))
- ("lux;DataT" "double")
+ (&/$DataT "double")
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class double-class) "valueOf" (str "(D)" (&host/->type-signature double-class)))
- ("lux;DataT" "char")
+ (&/$DataT "char")
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class char-class) "valueOf" (str "(C)" (&host/->type-signature char-class)))
- ("lux;DataT" _)
+ (&/$DataT _)
nil)
*writer*))
diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj
index 6f785905a..46e6ec2d9 100644
--- a/src/lux/compiler/type.clj
+++ b/src/lux/compiler/type.clj
@@ -40,18 +40,18 @@
(defn ->analysis [type]
"(-> Type Analysis)"
(|case type
- ("lux;DataT" ?class)
- (variant$ "lux;DataT" (text$ ?class))
+ (&/$DataT ?class)
+ (variant$ &/$DataT (text$ ?class))
- ("lux;TupleT" ?members)
- (variant$ "lux;TupleT"
+ (&/$TupleT ?members)
+ (variant$ &/$TupleT
(&/fold (fn [tail head]
(Cons$ (->analysis head) tail))
$Nil
(&/|reverse ?members)))
- ("lux;VariantT" ?cases)
- (variant$ "lux;VariantT"
+ (&/$VariantT ?cases)
+ (variant$ &/$VariantT
(&/fold (fn [tail head]
(|let [[hlabel htype] head]
(Cons$ (tuple$ (&/|list (text$ hlabel) (->analysis htype)))
@@ -59,8 +59,8 @@
$Nil
(&/|reverse ?cases)))
- ("lux;RecordT" ?slots)
- (variant$ "lux;RecordT"
+ (&/$RecordT ?slots)
+ (variant$ &/$RecordT
(&/fold (fn [tail head]
(|let [[hlabel htype] head]
(Cons$ (tuple$ (&/|list (text$ hlabel) (->analysis htype)))
@@ -68,11 +68,11 @@
$Nil
(&/|reverse ?slots)))
- ("lux;LambdaT" ?input ?output)
- (variant$ "lux;LambdaT" (tuple$ (&/|list (->analysis ?input) (->analysis ?output))))
+ (&/$LambdaT ?input ?output)
+ (variant$ &/$LambdaT (tuple$ (&/|list (->analysis ?input) (->analysis ?output))))
- ("lux;AllT" ?env ?name ?arg ?body)
- (variant$ "lux;AllT"
+ (&/$AllT ?env ?name ?arg ?body)
+ (variant$ &/$AllT
(tuple$ (&/|list (|case ?env
(&/$None)
(variant$ &/$None (tuple$ (&/|list)))
@@ -89,9 +89,9 @@
(text$ ?arg)
(->analysis ?body))))
- ("lux;BoundT" ?name)
- (variant$ "lux;BoundT" (text$ ?name))
+ (&/$BoundT ?name)
+ (variant$ &/$BoundT (text$ ?name))
- ("lux;AppT" ?fun ?arg)
- (variant$ "lux;AppT" (tuple$ (&/|list (->analysis ?fun) (->analysis ?arg))))
+ (&/$AppT ?fun ?arg)
+ (variant$ &/$AppT (tuple$ (&/|list (->analysis ?fun) (->analysis ?arg))))
))
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 3f1ffb25a..8ffe77b96 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -29,7 +29,7 @@
(.getSimpleName class)))]
(if (.equals "void" base)
(return &type/Unit)
- (return (&/V "lux;DataT" (str (reduce str "" (repeat (int (/ (count arr-level) 2)) "["))
+ (return (&/V &/$DataT (str (reduce str "" (repeat (int (/ (count arr-level) 2)) "["))
base)))
)))
@@ -69,13 +69,13 @@
(defn ->java-sig [^objects type]
(|case type
- ("lux;DataT" ?name)
+ (&/$DataT ?name)
(->type-signature ?name)
- ("lux;LambdaT" _ _)
+ (&/$LambdaT _ _)
(->type-signature function-class)
- ("lux;TupleT" (&/$Nil))
+ (&/$TupleT (&/$Nil))
"V"
))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 45c1f2247..0a80d4fbc 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -15,65 +15,65 @@
(declare show-type)
;; [Util]
-(def Bool (&/V "lux;DataT" "java.lang.Boolean"))
-(def Int (&/V "lux;DataT" "java.lang.Long"))
-(def Real (&/V "lux;DataT" "java.lang.Double"))
-(def Char (&/V "lux;DataT" "java.lang.Character"))
-(def Text (&/V "lux;DataT" "java.lang.String"))
-(def Unit (&/V "lux;TupleT" (&/|list)))
-(def $Void (&/V "lux;VariantT" (&/|list)))
+(def Bool (&/V &/$DataT "java.lang.Boolean"))
+(def Int (&/V &/$DataT "java.lang.Long"))
+(def Real (&/V &/$DataT "java.lang.Double"))
+(def Char (&/V &/$DataT "java.lang.Character"))
+(def Text (&/V &/$DataT "java.lang.String"))
+(def Unit (&/V &/$TupleT (&/|list)))
+(def $Void (&/V &/$VariantT (&/|list)))
(def IO
- (&/V "lux;AllT" (&/T (&/V &/$Some (&/V &/$Nil nil)) "IO" "a"
- (&/V "lux;LambdaT" (&/T Unit (&/V "lux;BoundT" "a"))))))
+ (&/V &/$AllT (&/T (&/V &/$Some (&/V &/$Nil nil)) "IO" "a"
+ (&/V &/$LambdaT (&/T Unit (&/V &/$BoundT "a"))))))
(def List
- (&/V "lux;AllT" (&/T (&/V &/$Some (&/V &/$Nil nil)) "lux;List" "a"
- (&/V "lux;VariantT" (&/|list (&/T &/$Nil Unit)
- (&/T &/$Cons (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "a")
- (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "lux;List")
- (&/V "lux;BoundT" "a")))))))))))
+ (&/V &/$AllT (&/T (&/V &/$Some (&/V &/$Nil nil)) "lux;List" "a"
+ (&/V &/$VariantT (&/|list (&/T &/$Nil Unit)
+ (&/T &/$Cons (&/V &/$TupleT (&/|list (&/V &/$BoundT "a")
+ (&/V &/$AppT (&/T (&/V &/$BoundT "lux;List")
+ (&/V &/$BoundT "a")))))))))))
(def Maybe
- (&/V "lux;AllT" (&/T (&/V &/$Some (&/V &/$Nil nil)) "lux;Maybe" "a"
- (&/V "lux;VariantT" (&/|list (&/T &/$None Unit)
- (&/T &/$Some (&/V "lux;BoundT" "a")))))))
+ (&/V &/$AllT (&/T (&/V &/$Some (&/V &/$Nil nil)) "lux;Maybe" "a"
+ (&/V &/$VariantT (&/|list (&/T &/$None Unit)
+ (&/T &/$Some (&/V &/$BoundT "a")))))))
(def Type
- (let [Type (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "Type") (&/V "lux;BoundT" "_")))
- TypeEnv (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text Type))))
- TypePair (&/V "lux;TupleT" (&/|list Type Type))]
- (&/V "lux;AppT" (&/T (&/V "lux;AllT" (&/T (&/V &/$Some (&/V &/$Nil nil)) "Type" "_"
- (&/V "lux;VariantT" (&/|list (&/T "lux;DataT" Text)
- (&/T "lux;TupleT" (&/V "lux;AppT" (&/T List Type)))
- (&/T "lux;VariantT" TypeEnv)
- (&/T "lux;RecordT" TypeEnv)
- (&/T "lux;LambdaT" TypePair)
- (&/T "lux;BoundT" Text)
- (&/T "lux;VarT" Int)
- (&/T "lux;AllT" (&/V "lux;TupleT" (&/|list (&/V "lux;AppT" (&/T Maybe TypeEnv)) Text Text Type)))
- (&/T "lux;AppT" TypePair)
- (&/T "lux;ExT" Int)
+ (let [Type (&/V &/$AppT (&/T (&/V &/$BoundT "Type") (&/V &/$BoundT "_")))
+ TypeEnv (&/V &/$AppT (&/T List (&/V &/$TupleT (&/|list Text Type))))
+ TypePair (&/V &/$TupleT (&/|list Type Type))]
+ (&/V &/$AppT (&/T (&/V &/$AllT (&/T (&/V &/$Some (&/V &/$Nil nil)) "Type" "_"
+ (&/V &/$VariantT (&/|list (&/T &/$DataT Text)
+ (&/T &/$TupleT (&/V &/$AppT (&/T List Type)))
+ (&/T &/$VariantT TypeEnv)
+ (&/T &/$RecordT TypeEnv)
+ (&/T &/$LambdaT TypePair)
+ (&/T &/$BoundT Text)
+ (&/T &/$VarT Int)
+ (&/T &/$AllT (&/V &/$TupleT (&/|list (&/V &/$AppT (&/T Maybe TypeEnv)) Text Text Type)))
+ (&/T &/$AppT TypePair)
+ (&/T &/$ExT Int)
))))
$Void))))
(defn fAll [name arg body]
- (&/V "lux;AllT" (&/T (&/V &/$None nil) name arg body)))
+ (&/V &/$AllT (&/T (&/V &/$None nil) name arg body)))
(def Bindings
(fAll "lux;Bindings" "k"
(fAll "" "v"
- (&/V "lux;RecordT" (&/|list (&/T "lux;counter" Int)
- (&/T "lux;mappings" (&/V "lux;AppT" (&/T List
- (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "k")
- (&/V "lux;BoundT" "v")))))))))))
+ (&/V &/$RecordT (&/|list (&/T "lux;counter" Int)
+ (&/T "lux;mappings" (&/V &/$AppT (&/T List
+ (&/V &/$TupleT (&/|list (&/V &/$BoundT "k")
+ (&/V &/$BoundT "v")))))))))))
(def Env
- (let [bindings (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings (&/V "lux;BoundT" "k")))
- (&/V "lux;BoundT" "v")))]
+ (let [bindings (&/V &/$AppT (&/T (&/V &/$AppT (&/T Bindings (&/V &/$BoundT "k")))
+ (&/V &/$BoundT "v")))]
(fAll "lux;Env" "k"
(fAll "" "v"
- (&/V "lux;RecordT"
+ (&/V &/$RecordT
(&/|list (&/T "lux;name" Text)
(&/T "lux;inner-closures" Int)
(&/T "lux;locals" bindings)
@@ -81,23 +81,23 @@
))))))
(def Cursor
- (&/V "lux;TupleT" (&/|list Text Int Int)))
+ (&/V &/$TupleT (&/|list Text Int Int)))
(def Meta
(fAll &/$Meta "m"
(fAll "" "v"
- (&/V "lux;VariantT" (&/|list (&/T &/$Meta (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "m")
- (&/V "lux;BoundT" "v")))))))))
+ (&/V &/$VariantT (&/|list (&/T &/$Meta (&/V &/$TupleT (&/|list (&/V &/$BoundT "m")
+ (&/V &/$BoundT "v")))))))))
-(def Ident (&/V "lux;TupleT" (&/|list Text Text)))
+(def Ident (&/V &/$TupleT (&/|list Text Text)))
(def AST*
- (let [AST* (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "w")
- (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "lux;AST'")
- (&/V "lux;BoundT" "w")))))
- AST*List (&/V "lux;AppT" (&/T List AST*))]
+ (let [AST* (&/V &/$AppT (&/T (&/V &/$BoundT "w")
+ (&/V &/$AppT (&/T (&/V &/$BoundT "lux;AST'")
+ (&/V &/$BoundT "w")))))
+ AST*List (&/V &/$AppT (&/T List AST*))]
(fAll "lux;AST'" "w"
- (&/V "lux;VariantT" (&/|list (&/T &/$BoolS Bool)
+ (&/V &/$VariantT (&/|list (&/T &/$BoolS Bool)
(&/T &/$IntS Int)
(&/T &/$RealS Real)
(&/T &/$CharS Char)
@@ -106,75 +106,75 @@
(&/T &/$TagS Ident)
(&/T &/$FormS AST*List)
(&/T &/$TupleS AST*List)
- (&/T &/$RecordS (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list AST* AST*))))))
+ (&/T &/$RecordS (&/V &/$AppT (&/T List (&/V &/$TupleT (&/|list AST* AST*))))))
))))
(def AST
- (let [w (&/V "lux;AppT" (&/T Meta Cursor))]
- (&/V "lux;AppT" (&/T w (&/V "lux;AppT" (&/T AST* w))))))
+ (let [w (&/V &/$AppT (&/T Meta Cursor))]
+ (&/V &/$AppT (&/T w (&/V &/$AppT (&/T AST* w))))))
-(def ^:private ASTList (&/V "lux;AppT" (&/T List AST)))
+(def ^:private ASTList (&/V &/$AppT (&/T List AST)))
(def Either
(fAll "lux;Either" "l"
(fAll "" "r"
- (&/V "lux;VariantT" (&/|list (&/T &/$Left (&/V "lux;BoundT" "l"))
- (&/T &/$Right (&/V "lux;BoundT" "r")))))))
+ (&/V &/$VariantT (&/|list (&/T &/$Left (&/V &/$BoundT "l"))
+ (&/T &/$Right (&/V &/$BoundT "r")))))))
(def StateE
(fAll "lux;StateE" "s"
(fAll "" "a"
- (&/V "lux;LambdaT" (&/T (&/V "lux;BoundT" "s")
- (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Either Text))
- (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "s")
- (&/V "lux;BoundT" "a"))))))))))
+ (&/V &/$LambdaT (&/T (&/V &/$BoundT "s")
+ (&/V &/$AppT (&/T (&/V &/$AppT (&/T Either Text))
+ (&/V &/$TupleT (&/|list (&/V &/$BoundT "s")
+ (&/V &/$BoundT "a"))))))))))
(def Reader
- (&/V "lux;AppT" (&/T List
- (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Meta Cursor))
+ (&/V &/$AppT (&/T List
+ (&/V &/$AppT (&/T (&/V &/$AppT (&/T Meta Cursor))
Text)))))
(def HostState
- (&/V "lux;RecordT"
- (&/|list (&/T "lux;writer" (&/V "lux;DataT" "org.objectweb.asm.ClassWriter"))
- (&/T "lux;loader" (&/V "lux;DataT" "java.lang.ClassLoader"))
- (&/T "lux;classes" (&/V "lux;DataT" "clojure.lang.Atom")))))
+ (&/V &/$RecordT
+ (&/|list (&/T "lux;writer" (&/V &/$DataT "org.objectweb.asm.ClassWriter"))
+ (&/T "lux;loader" (&/V &/$DataT "java.lang.ClassLoader"))
+ (&/T "lux;classes" (&/V &/$DataT "clojure.lang.Atom")))))
(def DefData*
(fAll "lux;DefData'" ""
- (&/V "lux;VariantT" (&/|list (&/T "lux;TypeD" Type)
- (&/T "lux;ValueD" (&/V "lux;TupleT" (&/|list Type Unit)))
- (&/T "lux;MacroD" (&/V "lux;BoundT" ""))
+ (&/V &/$VariantT (&/|list (&/T "lux;TypeD" Type)
+ (&/T "lux;ValueD" (&/V &/$TupleT (&/|list Type Unit)))
+ (&/T "lux;MacroD" (&/V &/$BoundT ""))
(&/T "lux;AliasD" Ident)))))
(def LuxVar
- (&/V "lux;VariantT" (&/|list (&/T "lux;Local" Int)
+ (&/V &/$VariantT (&/|list (&/T "lux;Local" Int)
(&/T "lux;Global" Ident))))
(def $Module
(fAll "lux;$Module" "Compiler"
- (&/V "lux;RecordT"
- (&/|list (&/T "lux;module-aliases" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text Text)))))
- (&/T "lux;defs" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT"
+ (&/V &/$RecordT
+ (&/|list (&/T "lux;module-aliases" (&/V &/$AppT (&/T List (&/V &/$TupleT (&/|list Text Text)))))
+ (&/T "lux;defs" (&/V &/$AppT (&/T List (&/V &/$TupleT
(&/|list Text
- (&/V "lux;TupleT" (&/|list Bool
- (&/V "lux;AppT" (&/T DefData*
- (&/V "lux;LambdaT" (&/T ASTList
- (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE (&/V "lux;BoundT" "Compiler")))
+ (&/V &/$TupleT (&/|list Bool
+ (&/V &/$AppT (&/T DefData*
+ (&/V &/$LambdaT (&/T ASTList
+ (&/V &/$AppT (&/T (&/V &/$AppT (&/T StateE (&/V &/$BoundT "Compiler")))
ASTList)))))))))))))
- (&/T "lux;imports" (&/V "lux;AppT" (&/T List Text)))))))
+ (&/T "lux;imports" (&/V &/$AppT (&/T List Text)))))))
(def $Compiler
- (&/V "lux;AppT" (&/T (fAll "lux;Compiler" ""
- (&/V "lux;RecordT"
+ (&/V &/$AppT (&/T (fAll "lux;Compiler" ""
+ (&/V &/$RecordT
(&/|list (&/T "lux;source" Reader)
- (&/T "lux;modules" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT"
+ (&/T "lux;modules" (&/V &/$AppT (&/T List (&/V &/$TupleT
(&/|list Text
- (&/V "lux;AppT" (&/T $Module (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "lux;Compiler") (&/V "lux;BoundT" ""))))))))))
- (&/T "lux;envs" (&/V "lux;AppT" (&/T List
- (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Env Text))
- (&/V "lux;TupleT" (&/|list LuxVar Type)))))))
- (&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type)))
+ (&/V &/$AppT (&/T $Module (&/V &/$AppT (&/T (&/V &/$BoundT "lux;Compiler") (&/V &/$BoundT ""))))))))))
+ (&/T "lux;envs" (&/V &/$AppT (&/T List
+ (&/V &/$AppT (&/T (&/V &/$AppT (&/T Env Text))
+ (&/V &/$TupleT (&/|list LuxVar Type)))))))
+ (&/T "lux;types" (&/V &/$AppT (&/T (&/V &/$AppT (&/T Bindings Int)) Type)))
(&/T "lux;host" HostState)
(&/T "lux;seed" Int)
(&/T "lux;eval?" Bool)
@@ -184,8 +184,8 @@
$Void)))
(def Macro
- (&/V "lux;LambdaT" (&/T ASTList
- (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE $Compiler))
+ (&/V &/$LambdaT (&/T ASTList
+ (&/V &/$AppT (&/T (&/V &/$AppT (&/T StateE $Compiler))
ASTList)))))
(defn bound? [id]
@@ -237,7 +237,7 @@
(def existential
(|do [seed &/gen-id]
- (return (&/V "lux;ExT" seed))))
+ (return (&/V &/$ExT seed))))
(declare clean*)
(defn ^:private delete-var [id]
@@ -257,7 +257,7 @@
(&/$Some ?type*)
(|case ?type*
- ("lux;VarT" ?id*)
+ (&/$VarT ?id*)
(if (.equals ^Object id ?id*)
(return (&/T ?id (&/V &/$None nil)))
(return binding))
@@ -277,52 +277,52 @@
(defn with-var [k]
(|do [id create-var
- output (k (&/V "lux;VarT" id))
+ output (k (&/V &/$VarT id))
_ (delete-var id)]
(return output)))
(defn with-vars [amount k]
(|do [=vars (&/map% (constantly create-var) (&/|range amount))
- output (k (&/|map #(&/V "lux;VarT" %) =vars))
+ output (k (&/|map #(&/V &/$VarT %) =vars))
_ (&/map% delete-var (&/|reverse =vars))]
(return output)))
(defn clean* [?tid type]
(|case type
- ("lux;VarT" ?id)
+ (&/$VarT ?id)
(if (.equals ^Object ?tid ?id)
(deref ?id)
(return type))
- ("lux;LambdaT" ?arg ?return)
+ (&/$LambdaT ?arg ?return)
(|do [=arg (clean* ?tid ?arg)
=return (clean* ?tid ?return)]
- (return (&/V "lux;LambdaT" (&/T =arg =return))))
+ (return (&/V &/$LambdaT (&/T =arg =return))))
- ("lux;AppT" ?lambda ?param)
+ (&/$AppT ?lambda ?param)
(|do [=lambda (clean* ?tid ?lambda)
=param (clean* ?tid ?param)]
- (return (&/V "lux;AppT" (&/T =lambda =param))))
+ (return (&/V &/$AppT (&/T =lambda =param))))
- ("lux;TupleT" ?members)
+ (&/$TupleT ?members)
(|do [=members (&/map% (partial clean* ?tid) ?members)]
- (return (&/V "lux;TupleT" =members)))
+ (return (&/V &/$TupleT =members)))
- ("lux;VariantT" ?members)
+ (&/$VariantT ?members)
(|do [=members (&/map% (fn [[k v]]
(|do [=v (clean* ?tid v)]
(return (&/T k =v))))
?members)]
- (return (&/V "lux;VariantT" =members)))
+ (return (&/V &/$VariantT =members)))
- ("lux;RecordT" ?members)
+ (&/$RecordT ?members)
(|do [=members (&/map% (fn [[k v]]
(|do [=v (clean* ?tid v)]
(return (&/T k =v))))
?members)]
- (return (&/V "lux;RecordT" =members)))
+ (return (&/V &/$RecordT =members)))
- ("lux;AllT" ?env ?name ?arg ?body)
+ (&/$AllT ?env ?name ?arg ?body)
(|do [=env (|case ?env
(&/$None)
(return ?env)
@@ -334,7 +334,7 @@
?env*)]
(return (&/V &/$Some clean-env))))
body* (clean* ?tid ?body)]
- (return (&/V "lux;AllT" (&/T =env ?name ?arg body*))))
+ (return (&/V &/$AllT (&/T =env ?name ?arg body*))))
_
(return type)
@@ -342,7 +342,7 @@
(defn clean [tvar type]
(|case tvar
- ("lux;VarT" ?id)
+ (&/$VarT ?id)
(clean* ?id type)
_
@@ -350,7 +350,7 @@
(defn ^:private unravel-fun [type]
(|case type
- ("lux;LambdaT" ?in ?out)
+ (&/$LambdaT ?in ?out)
(|let [[??out ?args] (unravel-fun ?out)]
(&/T ??out (&/|cons ?in ?args)))
@@ -359,7 +359,7 @@
(defn ^:private unravel-app [fun-type]
(|case fun-type
- ("lux;AppT" ?left ?right)
+ (&/$AppT ?left ?right)
(|let [[?fun-type ?args] (unravel-app ?left)]
(&/T ?fun-type (&/|++ ?args (&/|list ?right))))
@@ -368,21 +368,21 @@
(defn show-type [^objects type]
(|case type
- ("lux;DataT" name)
+ (&/$DataT name)
(str "(^ " name ")")
- ("lux;TupleT" elems)
+ (&/$TupleT elems)
(if (&/|empty? elems)
"(,)"
(str "(, " (->> elems (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")"))
- ("lux;VariantT" cases)
+ (&/$VariantT cases)
(if (&/|empty? cases)
"(|)"
(str "(| " (->> cases
(&/|map (fn [kv]
(|case kv
- [k ("lux;TupleT" (&/$Nil))]
+ [k (&/$TupleT (&/$Nil))]
(str "#" k)
[k v]
@@ -391,7 +391,7 @@
(&/fold str "")) ")"))
- ("lux;RecordT" fields)
+ (&/$RecordT fields)
(str "(& " (->> fields
(&/|map (fn [kv]
(|case kv
@@ -400,29 +400,29 @@
(&/|interpose " ")
(&/fold str "")) ")")
- ("lux;LambdaT" input output)
+ (&/$LambdaT input output)
(|let [[?out ?ins] (unravel-fun type)]
(str "(-> " (->> ?ins (&/|map show-type) (&/|interpose " ") (&/fold str "")) " " (show-type ?out) ")"))
- ("lux;VarT" id)
+ (&/$VarT id)
(str "⌈" id "⌋")
- ("lux;ExT" ?id)
+ (&/$ExT ?id)
(str "⟨" ?id "⟩")
- ("lux;BoundT" name)
+ (&/$BoundT name)
name
- ("lux;AppT" _ _)
+ (&/$AppT _ _)
(|let [[?call-fun ?call-args] (unravel-app type)]
(str "(" (show-type ?call-fun) " " (->> ?call-args (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")"))
- ("lux;AllT" ?env ?name ?arg ?body)
+ (&/$AllT ?env ?name ?arg ?body)
(if (= "" ?name)
(let [[args body] (loop [args (list ?arg)
body* ?body]
(|case body*
- ("lux;AllT" ?env* ?name* ?arg* ?body*)
+ (&/$AllT ?env* ?name* ?arg* ?body*)
(recur (cons ?arg* args) ?body*)
_
@@ -434,16 +434,16 @@
(defn type= [x y]
(or (clojure.lang.Util/identical x y)
(let [output (|case [x y]
- [("lux;DataT" xname) ("lux;DataT" yname)]
+ [(&/$DataT xname) (&/$DataT yname)]
(.equals ^Object xname yname)
- [("lux;TupleT" xelems) ("lux;TupleT" yelems)]
+ [(&/$TupleT xelems) (&/$TupleT yelems)]
(&/fold2 (fn [old x y]
(and old (type= x y)))
true
xelems yelems)
- [("lux;VariantT" xcases) ("lux;VariantT" ycases)]
+ [(&/$VariantT xcases) (&/$VariantT ycases)]
(&/fold2 (fn [old xcase ycase]
(|let [[xname xtype] xcase
[yname ytype] ycase]
@@ -451,7 +451,7 @@
true
xcases ycases)
- [("lux;RecordT" xslots) ("lux;RecordT" yslots)]
+ [(&/$RecordT xslots) (&/$RecordT yslots)]
(&/fold2 (fn [old xslot yslot]
(|let [[xname xtype] xslot
[yname ytype] yslot]
@@ -459,23 +459,23 @@
true
xslots yslots)
- [("lux;LambdaT" xinput xoutput) ("lux;LambdaT" yinput youtput)]
+ [(&/$LambdaT xinput xoutput) (&/$LambdaT yinput youtput)]
(and (type= xinput yinput)
(type= xoutput youtput))
- [("lux;VarT" xid) ("lux;VarT" yid)]
+ [(&/$VarT xid) (&/$VarT yid)]
(.equals ^Object xid yid)
- [("lux;BoundT" xname) ("lux;BoundT" yname)]
+ [(&/$BoundT xname) (&/$BoundT yname)]
(.equals ^Object xname yname)
- [("lux;ExT" xid) ("lux;ExT" yid)]
+ [(&/$ExT xid) (&/$ExT yid)]
(.equals ^Object xid yid)
- [("lux;AppT" xlambda xparam) ("lux;AppT" ylambda yparam)]
+ [(&/$AppT xlambda xparam) (&/$AppT ylambda yparam)]
(and (type= xlambda ylambda) (type= xparam yparam))
- [("lux;AllT" xenv xname xarg xbody) ("lux;AllT" yenv yname yarg ybody)]
+ [(&/$AllT xenv xname xarg xbody) (&/$AllT yenv yname yarg ybody)]
(and (.equals ^Object xname yname)
(.equals ^Object xarg yarg)
;; (matchv ::M/objects [xenv yenv]
@@ -522,36 +522,36 @@
(defn beta-reduce [env type]
(|case type
- ("lux;VariantT" ?cases)
- (&/V "lux;VariantT" (&/|map (fn [kv]
+ (&/$VariantT ?cases)
+ (&/V &/$VariantT (&/|map (fn [kv]
(|let [[k v] kv]
(&/T k (beta-reduce env v))))
?cases))
- ("lux;RecordT" ?fields)
- (&/V "lux;RecordT" (&/|map (fn [kv]
+ (&/$RecordT ?fields)
+ (&/V &/$RecordT (&/|map (fn [kv]
(|let [[k v] kv]
(&/T k (beta-reduce env v))))
?fields))
- ("lux;TupleT" ?members)
- (&/V "lux;TupleT" (&/|map (partial beta-reduce env) ?members))
+ (&/$TupleT ?members)
+ (&/V &/$TupleT (&/|map (partial beta-reduce env) ?members))
- ("lux;AppT" ?type-fn ?type-arg)
- (&/V "lux;AppT" (&/T (beta-reduce env ?type-fn) (beta-reduce env ?type-arg)))
+ (&/$AppT ?type-fn ?type-arg)
+ (&/V &/$AppT (&/T (beta-reduce env ?type-fn) (beta-reduce env ?type-arg)))
- ("lux;AllT" ?local-env ?local-name ?local-arg ?local-def)
+ (&/$AllT ?local-env ?local-name ?local-arg ?local-def)
(|case ?local-env
(&/$None)
- (&/V "lux;AllT" (&/T (&/V &/$Some env) ?local-name ?local-arg ?local-def))
+ (&/V &/$AllT (&/T (&/V &/$Some env) ?local-name ?local-arg ?local-def))
(&/$Some _)
type)
- ("lux;LambdaT" ?input ?output)
- (&/V "lux;LambdaT" (&/T (beta-reduce env ?input) (beta-reduce env ?output)))
+ (&/$LambdaT ?input ?output)
+ (&/V &/$LambdaT (&/T (beta-reduce env ?input) (beta-reduce env ?output)))
- ("lux;BoundT" ?name)
+ (&/$BoundT ?name)
(if-let [bound (&/|get ?name env)]
(beta-reduce env bound)
type)
@@ -562,7 +562,7 @@
(defn apply-type [type-fn param]
(|case type-fn
- ("lux;AllT" local-env local-name local-arg local-def)
+ (&/$AllT local-env local-name local-arg local-def)
(let [local-env* (|case local-env
(&/$None)
(&/|table)
@@ -574,7 +574,7 @@
(&/|put local-arg param))
local-def)))
- ("lux;AppT" F A)
+ (&/$AppT F A)
(|do [type-fn* (apply-type F A)]
(apply-type type-fn* param))
@@ -602,7 +602,7 @@
(if (clojure.lang.Util/identical expected actual)
(return (&/T fixpoints nil))
(|case [expected actual]
- [("lux;VarT" ?eid) ("lux;VarT" ?aid)]
+ [(&/$VarT ?eid) (&/$VarT ?aid)]
(if (.equals ^Object ?eid ?aid)
(return (&/T fixpoints nil))
(|do [ebound (fn [state]
@@ -633,7 +633,7 @@
[(&/$Some etype) (&/$Some atype)]
(check* class-loader fixpoints etype atype))))
- [("lux;VarT" ?id) _]
+ [(&/$VarT ?id) _]
(fn [state]
(|case ((set-var ?id actual) state)
(&/$Right state* _)
@@ -644,7 +644,7 @@
(check* class-loader fixpoints bound actual))
state)))
- [_ ("lux;VarT" ?id)]
+ [_ (&/$VarT ?id)]
(fn [state]
(|case ((set-var ?id expected) state)
(&/$Right state* _)
@@ -655,18 +655,18 @@
(check* class-loader fixpoints expected bound))
state)))
- [("lux;AppT" ("lux;VarT" ?eid) A1) ("lux;AppT" ("lux;VarT" ?aid) A2)]
+ [(&/$AppT (&/$VarT ?eid) A1) (&/$AppT (&/$VarT ?aid) A2)]
(fn [state]
(|case ((|do [F1 (deref ?eid)]
(fn [state]
(|case [((|do [F2 (deref ?aid)]
- (check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2))))
+ (check* class-loader fixpoints (&/V &/$AppT (&/T F1 A1)) (&/V &/$AppT (&/T F2 A2))))
state)]
(&/$Right state* output)
(return* state* output)
(&/$Left _)
- ((check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)
+ ((check* class-loader fixpoints (&/V &/$AppT (&/T F1 A1)) actual)
state))))
state)
(&/$Right state* output)
@@ -674,65 +674,65 @@
(&/$Left _)
(|case ((|do [F2 (deref ?aid)]
- (check* class-loader fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
+ (check* class-loader fixpoints expected (&/V &/$AppT (&/T F2 A2))))
state)
(&/$Right state* output)
(return* state* output)
(&/$Left _)
- ((|do [[fixpoints* _] (check* class-loader fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid))
+ ((|do [[fixpoints* _] (check* class-loader fixpoints (&/V &/$VarT ?eid) (&/V &/$VarT ?aid))
[fixpoints** _] (check* class-loader fixpoints* A1 A2)]
(return (&/T fixpoints** nil)))
state))))
- ;; (|do [_ (check* class-loader fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid))
+ ;; (|do [_ (check* class-loader fixpoints (&/V &/$VarT ?eid) (&/V &/$VarT ?aid))
;; _ (check* class-loader fixpoints A1 A2)]
;; (return (&/T fixpoints nil)))
- [("lux;AppT" ("lux;VarT" ?id) A1) ("lux;AppT" F2 A2)]
+ [(&/$AppT (&/$VarT ?id) A1) (&/$AppT F2 A2)]
(fn [state]
(|case ((|do [F1 (deref ?id)]
- (check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual))
+ (check* class-loader fixpoints (&/V &/$AppT (&/T F1 A1)) actual))
state)
(&/$Right state* output)
(return* state* output)
(&/$Left _)
- ((|do [[fixpoints* _] (check* class-loader fixpoints (&/V "lux;VarT" ?id) F2)
+ ((|do [[fixpoints* _] (check* class-loader fixpoints (&/V &/$VarT ?id) F2)
e* (apply-type F2 A1)
a* (apply-type F2 A2)
[fixpoints** _] (check* class-loader fixpoints* e* a*)]
(return (&/T fixpoints** nil)))
state)))
- ;; [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]]
- ;; (|do [[fixpoints* _] (check* class-loader fixpoints (&/V "lux;VarT" ?id) F2)
+ ;; [[&/$AppT [[&/$VarT ?id] A1]] [&/$AppT [F2 A2]]]
+ ;; (|do [[fixpoints* _] (check* class-loader fixpoints (&/V &/$VarT ?id) F2)
;; e* (apply-type F2 A1)
;; a* (apply-type F2 A2)
;; [fixpoints** _] (check* class-loader fixpoints* e* a*)]
;; (return (&/T fixpoints** nil)))
- [("lux;AppT" F1 A1) ("lux;AppT" ("lux;VarT" ?id) A2)]
+ [(&/$AppT F1 A1) (&/$AppT (&/$VarT ?id) A2)]
(fn [state]
(|case ((|do [F2 (deref ?id)]
- (check* class-loader fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
+ (check* class-loader fixpoints expected (&/V &/$AppT (&/T F2 A2))))
state)
(&/$Right state* output)
(return* state* output)
(&/$Left _)
- ((|do [[fixpoints* _] (check* class-loader fixpoints F1 (&/V "lux;VarT" ?id))
+ ((|do [[fixpoints* _] (check* class-loader fixpoints F1 (&/V &/$VarT ?id))
e* (apply-type F1 A1)
a* (apply-type F1 A2)
[fixpoints** _] (check* class-loader fixpoints* e* a*)]
(return (&/T fixpoints** nil)))
state)))
- ;; [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]]
- ;; (|do [[fixpoints* _] (check* class-loader fixpoints F1 (&/V "lux;VarT" ?id))
+ ;; [[&/$AppT [F1 A1]] [&/$AppT [[&/$VarT ?id] A2]]]
+ ;; (|do [[fixpoints* _] (check* class-loader fixpoints F1 (&/V &/$VarT ?id))
;; e* (apply-type F1 A1)
;; a* (apply-type F1 A2)
;; [fixpoints** _] (check* class-loader fixpoints* e* a*)]
;; (return (&/T fixpoints** nil)))
- [("lux;AppT" F A) _]
+ [(&/$AppT F A) _]
(let [fp-pair (&/T expected actual)
_ (when (> (&/|length fixpoints) 40)
(println 'FIXPOINTS (->> (&/|keys fixpoints)
@@ -753,28 +753,28 @@
(|do [expected* (apply-type F A)]
(check* class-loader (fp-put fp-pair true fixpoints) expected* actual))))
- [_ ("lux;AppT" F A)]
+ [_ (&/$AppT F A)]
(|do [actual* (apply-type F A)]
(check* class-loader fixpoints expected actual*))
- [("lux;AllT" _) _]
+ [(&/$AllT _) _]
(with-var
(fn [$arg]
(|do [expected* (apply-type expected $arg)]
(check* class-loader fixpoints expected* actual))))
- [_ ("lux;AllT" _)]
+ [_ (&/$AllT _)]
(with-var
(fn [$arg]
(|do [actual* (apply-type actual $arg)]
(check* class-loader fixpoints expected actual*))))
- [("lux;DataT" e!name) ("lux;DataT" "null")]
+ [(&/$DataT e!name) (&/$DataT "null")]
(if (contains? primitive-types e!name)
(fail (str "[Type Error] Can't use \"null\" with primitive types."))
(return (&/T fixpoints nil)))
- [["lux;DataT" e!name] ["lux;DataT" a!name]]
+ [(&/$DataT e!name) (&/$DataT a!name)]
(let [e!name (as-obj e!name)
a!name (as-obj a!name)]
(if (or (.equals ^Object e!name a!name)
@@ -782,11 +782,11 @@
(return (&/T fixpoints nil))
(fail (str "[Type Error] Names don't match: " e!name " =/= " a!name))))
- [("lux;LambdaT" eI eO) ("lux;LambdaT" aI aO)]
+ [(&/$LambdaT eI eO) (&/$LambdaT aI aO)]
(|do [[fixpoints* _] (check* class-loader fixpoints aI eI)]
(check* class-loader fixpoints* eO aO))
- [("lux;TupleT" e!members) ("lux;TupleT" a!members)]
+ [(&/$TupleT e!members) (&/$TupleT a!members)]
(|do [fixpoints* (&/fold2% (fn [fp e a]
(|do [[fp* _] (check* class-loader fp e a)]
(return fp*)))
@@ -794,7 +794,7 @@
e!members a!members)]
(return (&/T fixpoints* nil)))
- [("lux;VariantT" e!cases) ("lux;VariantT" a!cases)]
+ [(&/$VariantT e!cases) (&/$VariantT a!cases)]
(|do [fixpoints* (&/fold2% (fn [fp e!case a!case]
(|let [[e!name e!type] e!case
[a!name a!type] a!case]
@@ -806,7 +806,7 @@
e!cases a!cases)]
(return (&/T fixpoints* nil)))
- [("lux;RecordT" e!slots) ("lux;RecordT" a!slots)]
+ [(&/$RecordT e!slots) (&/$RecordT a!slots)]
(|do [fixpoints* (&/fold2% (fn [fp e!slot a!slot]
(|let [[e!name e!type] e!slot
[a!name a!type] a!slot]
@@ -818,7 +818,7 @@
e!slots a!slots)]
(return (&/T fixpoints* nil)))
- [("lux;ExT" e!id) ("lux;ExT" a!id)]
+ [(&/$ExT e!id) (&/$ExT a!id)]
(if (.equals ^Object e!id a!id)
(return (&/T fixpoints nil))
(fail (check-error expected actual)))
@@ -834,11 +834,11 @@
(defn apply-lambda [func param]
(|case func
- ("lux;LambdaT" input output)
+ (&/$LambdaT input output)
(|do [_ (check* init-fixpoints input param)]
(return output))
- ("lux;AllT" _)
+ (&/$AllT _)
(with-var
(fn [$var]
(|do [func* (apply-type func $var)
@@ -851,11 +851,11 @@
(defn actual-type [type]
(|case type
- ("lux;AppT" ?all ?param)
+ (&/$AppT ?all ?param)
(|do [type* (apply-type ?all ?param)]
(actual-type type*))
- ("lux;VarT" ?id)
+ (&/$VarT ?id)
(deref ?id)
_
@@ -864,7 +864,7 @@
(defn variant-case [case type]
(|case type
- ("lux;VariantT" ?cases)
+ (&/$VariantT ?cases)
(if-let [case-type (&/|get case ?cases)]
(return case-type)
(fail (str "[Type Error] Variant lacks case: " case " | " (show-type type))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 20:15:35 +0000