aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj2
-rw-r--r--src/lux/analyser/base.clj2
-rw-r--r--src/lux/analyser/case.clj10
-rw-r--r--src/lux/analyser/lux.clj8
-rw-r--r--src/lux/analyser/module.clj2
-rw-r--r--src/lux/base.clj14
-rw-r--r--src/lux/compiler.clj2
-rw-r--r--src/lux/host.clj12
-rw-r--r--src/lux/lexer.clj19
-rw-r--r--src/lux/type.clj591
10 files changed, 332 insertions, 330 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 3c5c5c956..ba0fe4e66 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -514,7 +514,7 @@
(defn ^:private analyse-ast [eval! exo-type token]
(matchv ::M/objects [token]
[["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]] ?values]]]]]]
- (do (assert (= 1 (&/|length ?values)) "[Analyser Error] Can only tag 1 value.")
+ (do (assert (.equals ^Object (&/|length ?values) 1) "[Analyser Error] Can only tag 1 value.")
(&&lux/analyse-variant (partial analyse-ast eval!) exo-type ?ident (&/|head ?values)))
[["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [?fn ?args]]]]]]
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index a4c96c350..11e92f7b7 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -21,7 +21,7 @@
(defn resolved-ident [ident]
(|let [[?module ?name] ident]
- (|do [module* (if (= "" ?module)
+ (|do [module* (if (.equals "" ?module)
&/get-module-name
(return ?module))]
(return (&/ident->text (&/T module* ?name))))))
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index f27a541ee..43e5ee5e7 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -56,7 +56,7 @@
[["lux;TupleS" ?members]]
(matchv ::M/objects [value-type]
[["lux;TupleT" ?member-types]]
- (if (not (= (&/|length ?member-types) (&/|length ?members)))
+ (if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members)))
(fail (str "[Analyser error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]"))
(|do [[=tests =kont] (&/fold (fn [kont* vm]
(|let [[v m] vm]
@@ -74,7 +74,7 @@
(|do [value-type* (resolve-type value-type)]
(matchv ::M/objects [value-type*]
[["lux;RecordT" ?slot-types]]
- (if (not (= (&/|length ?slot-types) (&/|length ?slots)))
+ (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]
(|let [[sn sv] slot]
@@ -168,7 +168,7 @@
(return (&/V "TupleTotal" (&/T total? structs))))
[["TupleTotal" [total? ?values]] ["TupleTestAC" ?tests]]
- (if (= (&/|length ?values) (&/|length ?tests))
+ (if (.equals ^Object (&/|length ?values) (&/|length ?tests))
(|do [structs (&/map2% (fn [v t]
(merge-total v (&/T t ?body)))
?values ?tests)]
@@ -187,11 +187,11 @@
(return (&/V "RecordTotal" (&/T total? structs))))
[["RecordTotal" [total? ?values]] ["RecordTestAC" ?tests]]
- (if (= (&/|length ?values) (&/|length ?tests))
+ (if (.equals ^Object (&/|length ?values) (&/|length ?tests))
(|do [structs (&/map2% (fn [left right]
(|let [[lslot sub-struct] left
[rslot value]right]
- (if (= lslot rslot)
+ (if (.equals ^Object lslot rslot)
(|do [sub-struct* (merge-total sub-struct (&/T value ?body))]
(return (&/T lslot sub-struct*)))
(fail "[Pattern-matching error] Record slots mismatch."))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 7600f34ff..dff936fbe 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -110,7 +110,7 @@
[inner outer] (&/|split-with no-binding? stack)]
(matchv ::M/objects [outer]
[["lux;Nil" _]]
- ((|do [[[r-module r-name] $def] (&&module/find-def (if (= "" ?module) module-name ?module)
+ ((|do [[[r-module r-name] $def] (&&module/find-def (if (.equals "" ?module) module-name ?module)
?name)
endo-type (matchv ::M/objects [$def]
[["lux;ValueD" ?type]]
@@ -121,7 +121,8 @@
[["lux;TypeD" _]]
(return &type/Type))
- _ (if (and (= &type/Type endo-type) (= &type/Type exo-type))
+ _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
+ (clojure.lang.Util/identical &type/Type exo-type))
(return nil)
(&type/check exo-type endo-type))]
(return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
@@ -142,7 +143,8 @@
[["lux;TypeD" _]]
(return &type/Type))
- _ (if (and (= &type/Type endo-type) (= &type/Type exo-type))
+ _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
+ (clojure.lang.Util/identical &type/Type exo-type))
(return nil)
(&type/check exo-type endo-type))]
(return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index f36dc044a..f882f1275 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -68,7 +68,7 @@
(if-let [$def (&/|get name $module)]
(matchv ::M/objects [$def]
[[exported? $$def]]
- (if (or exported? (= current-module module))
+ (if (or exported? (.equals ^Object current-module module))
(matchv ::M/objects [$$def]
[["lux;AliasD" [?r-module ?r-name]]]
((find-def ?r-module ?r-name)
diff --git a/src/lux/base.clj b/src/lux/base.clj
index edf6781ea..7f551cdb0 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -85,7 +85,7 @@
nil
[["lux;Cons" [[k v] table*]]]
- (if (= k slot)
+ (if (.equals ^Object k slot)
v
(|get slot table*))))
@@ -95,7 +95,7 @@
(V "lux;Cons" (T (T slot value) (V "lux;Nil" nil)))
[["lux;Cons" [[k v] table*]]]
- (if (= k slot)
+ (if (.equals ^Object k slot)
(V "lux;Cons" (T (T slot value) table*))
(V "lux;Cons" (T (T k v) (|put slot value table*))))))
@@ -105,7 +105,7 @@
table
[["lux;Cons" [[k v] table*]]]
- (if (= k slot)
+ (if (.equals ^Object k slot)
table*
(V "lux;Cons" (T (T k v) (|remove slot table*))))))
@@ -115,7 +115,7 @@
table
[["lux;Cons" [[k* v] table*]]]
- (if (= k k*)
+ (if (.equals ^Object k k*)
(V "lux;Cons" (T (T k* (f v)) table*))
(V "lux;Cons" (T (T k* v) (|update k f table*))))))
@@ -233,7 +233,7 @@
false
[["lux;Cons" [[k* _] table*]]]
- (or (= k k*)
+ (or (.equals ^Object k k*)
(|contains? k table*))))
(defn fold [f init xs]
@@ -384,7 +384,7 @@
((exhaust% step) state*)
[["lux;Left" msg]]
- (if (= "[Reader Error] EOF" msg)
+ (if (.equals "[Reader Error] EOF" msg)
(return* state nil)
(fail* msg)))))
@@ -570,7 +570,7 @@
(str "#" ?module ";" ?tag)
[["lux;Meta" [_ ["lux;SymbolS" [?module ?ident]]]]]
- (if (= "" ?module)
+ (if (.equals "" ?module)
?ident
(str ?module ";" ?ident))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 6fb9e2c6d..e491fbdfe 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -346,7 +346,7 @@
(defn ^:private compile-module [name]
(fn [state]
(if (->> state (&/get$ &/$MODULES) (&/|contains? name))
- (if (= name "lux")
+ (if (.equals ^Object name "lux")
(return* state nil)
(fail* "[Compiler Error] Can't redefine a module!"))
(let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 77687dbef..8817ea338 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -18,7 +18,7 @@
(str (.getName pkg) ".")
"")
(.getSimpleName class)))]
- (if (= "void" base)
+ (if (.equals "void" base)
(return &type/$Void)
(return (&/V "lux;DataT" (str (reduce str "" (repeat (int (/ (count arr-level) 2)) "["))
base)))
@@ -78,8 +78,8 @@
(do-template [<name> <static?>]
(defn <name> [target field]
(if-let [type* (first (for [^Field =field (.getDeclaredFields (Class/forName target))
- :when (and (= field (.getName =field))
- (= <static?> (Modifier/isStatic (.getModifiers =field))))]
+ :when (and (.equals ^Object field (.getName =field))
+ (.equals ^Object <static?> (Modifier/isStatic (.getModifiers =field))))]
(.getType =field)))]
(|do [=type (class->type type*)]
(return =type))
@@ -92,9 +92,9 @@
(do-template [<name> <static?>]
(defn <name> [target method-name args]
(if-let [method (first (for [^Method =method (.getDeclaredMethods (Class/forName target))
- :when (and (= method-name (.getName =method))
- (= <static?> (Modifier/isStatic (.getModifiers =method)))
- (&/fold2 #(and %1 (= %2 %3))
+ :when (and (.equals ^Object method-name (.getName =method))
+ (.equals ^Object <static?> (Modifier/isStatic (.getModifiers =method)))
+ (&/fold2 #(and %1 (.equals ^Object %2 %3))
true
args
(&/|map #(.getName ^Class %) (&/->list (seq (.getParameterTypes =method))))))]
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index d2ab4a5d7..a137ca863 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -6,16 +6,15 @@
;; [Utils]
(defn ^:private escape-char [escaped]
- (condp = escaped
- "\\t" (return "\t")
- "\\b" (return "\b")
- "\\n" (return "\n")
- "\\r" (return "\r")
- "\\f" (return "\f")
- "\\\"" (return "\"")
- "\\\\" (return "\\")
- ;; else
- (fail (str "[Lexer Error] Unknown escape character: " escaped))))
+ (cond (.equals ^Object escaped "\\t") (return "\t")
+ (.equals ^Object escaped "\\b") (return "\b")
+ (.equals ^Object escaped "\\n") (return "\n")
+ (.equals ^Object escaped "\\r") (return "\r")
+ (.equals ^Object escaped "\\f") (return "\f")
+ (.equals ^Object escaped "\\\"") (return "\"")
+ (.equals ^Object escaped "\\\\") (return "\\")
+ :else
+ (fail (str "[Lexer Error] Unknown escape character: " escaped))))
(defn ^:private lex-text-body [_]
(&/try-all% (&/|list (|do [[_ [prefix escaped]] (&reader/read-regex2 #"(?s)^([^\"\\]*)(\\.)")
diff --git a/src/lux/type.clj b/src/lux/type.clj
index a2cf83624..25e3e1053 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -228,7 +228,7 @@
(fn [state]
((|do [mappings* (&/map% (fn [binding]
(|let [[?id ?type] binding]
- (if (= id ?id)
+ (if (.equals ^Object id ?id)
(return binding)
(matchv ::M/objects [?type]
[["lux;None" _]]
@@ -237,7 +237,7 @@
[["lux;Some" ?type*]]
(matchv ::M/objects [?type*]
[["lux;VarT" ?id*]]
- (if (= id ?id*)
+ (if (.equals ^Object id ?id*)
(return (&/T ?id (&/V "lux;None" nil)))
(return binding))
@@ -269,7 +269,7 @@
(defn ^:private clean* [?tid type]
(matchv ::M/objects [type]
[["lux;VarT" ?id]]
- (if (= ?tid ?id)
+ (if (.equals ^Object ?tid ?id)
(deref ?id)
(return type))
@@ -390,53 +390,52 @@
))
(defn type= [x y]
- (let [output (matchv ::M/objects [x y]
- [["lux;DataT" xname] ["lux;DataT" yname]]
- (= xname yname)
-
- [["lux;TupleT" xelems] ["lux;TupleT" yelems]]
- (&/fold2 (fn [old x y]
- (and old (type= x y)))
- true
- xelems yelems)
-
- [["lux;VariantT" xcases] ["lux;VariantT" ycases]]
- (&/fold2 (fn [old xcase ycase]
- (|let [[xname xtype] xcase
- [yname ytype] ycase]
- (and old (= xname yname) (type= xtype ytype))))
- true
- xcases ycases)
-
- [["lux;RecordT" xslots] ["lux;RecordT" yslots]]
- (&/fold2 (fn [old xslot yslot]
- (|let [[xname xtype] xslot
- [yname ytype] yslot]
- (and old (= xname yname) (type= xtype ytype))))
- true
- xslots yslots)
-
- [["lux;LambdaT" [xinput xoutput]] ["lux;LambdaT" [yinput youtput]]]
- (and (type= xinput yinput)
- (type= xoutput youtput))
-
- [["lux;VarT" xid] ["lux;VarT" yid]]
- (= xid yid)
-
- [["lux;BoundT" xname] ["lux;BoundT" yname]]
- (= xname yname)
-
- [["lux;ExT" xid] ["lux;ExT" yid]]
- (= xid yid)
-
- [["lux;AppT" [xlambda xparam]] ["lux;AppT" [ylambda yparam]]]
- (and (type= xlambda ylambda) (type= xparam yparam))
-
- [["lux;AllT" [xenv xname xarg xbody]] ["lux;AllT" [yenv yname yarg ybody]]]
- (or (and (not= "" xname)
- (= xname yname))
- (and (= xname yname)
- (= xarg yarg)
+ (or (clojure.lang.Util/identical x y)
+ (let [output (matchv ::M/objects [x y]
+ [["lux;DataT" xname] ["lux;DataT" yname]]
+ (.equals ^Object xname yname)
+
+ [["lux;TupleT" xelems] ["lux;TupleT" yelems]]
+ (&/fold2 (fn [old x y]
+ (and old (type= x y)))
+ true
+ xelems yelems)
+
+ [["lux;VariantT" xcases] ["lux;VariantT" ycases]]
+ (&/fold2 (fn [old xcase ycase]
+ (|let [[xname xtype] xcase
+ [yname ytype] ycase]
+ (and old (.equals ^Object xname yname) (type= xtype ytype))))
+ true
+ xcases ycases)
+
+ [["lux;RecordT" xslots] ["lux;RecordT" yslots]]
+ (&/fold2 (fn [old xslot yslot]
+ (|let [[xname xtype] xslot
+ [yname ytype] yslot]
+ (and old (.equals ^Object xname yname) (type= xtype ytype))))
+ true
+ xslots yslots)
+
+ [["lux;LambdaT" [xinput xoutput]] ["lux;LambdaT" [yinput youtput]]]
+ (and (type= xinput yinput)
+ (type= xoutput youtput))
+
+ [["lux;VarT" xid] ["lux;VarT" yid]]
+ (.equals ^Object xid yid)
+
+ [["lux;BoundT" xname] ["lux;BoundT" yname]]
+ (.equals ^Object xname yname)
+
+ [["lux;ExT" xid] ["lux;ExT" yid]]
+ (.equals ^Object xid yid)
+
+ [["lux;AppT" [xlambda xparam]] ["lux;AppT" [ylambda yparam]]]
+ (and (type= xlambda ylambda) (type= xparam yparam))
+
+ [["lux;AllT" [xenv xname xarg xbody]] ["lux;AllT" [yenv yname yarg ybody]]]
+ (and (.equals ^Object xname yname)
+ (.equals ^Object xarg yarg)
;; (matchv ::M/objects [xenv yenv]
;; [["lux;None" _] ["lux;None" _]]
;; true
@@ -451,12 +450,12 @@
;; [_ _]
;; false)
(type= xbody ybody)
- ))
+ )
- [_ _]
- false
- )]
- output))
+ [_ _]
+ false
+ )]
+ output)))
(defn ^:private fp-get [k fixpoints]
(|let [[e a] k]
@@ -553,272 +552,274 @@
(defn ^:private check* [fixpoints expected actual]
;; (swap! counter update-in [[(aget expected 0) (aget actual 0)]]
;; #(inc (or % 0)))
- (matchv ::M/objects [expected actual]
- [["lux;VarT" ?eid] ["lux;VarT" ?aid]]
- (if (= ?eid ?aid)
- (return (&/T fixpoints nil))
- (|do [ebound (fn [state]
- (matchv ::M/objects [((deref ?eid) state)]
- [["lux;Right" [state* ebound]]]
- (return* state* (&/V "lux;Some" ebound))
-
- [["lux;Left" _]]
- (return* state (&/V "lux;None" nil))))
- abound (fn [state]
- (matchv ::M/objects [((deref ?aid) state)]
- [["lux;Right" [state* abound]]]
- (return* state* (&/V "lux;Some" abound))
-
- [["lux;Left" _]]
- (return* state (&/V "lux;None" nil))))]
- (matchv ::M/objects [ebound abound]
- [["lux;None" _] ["lux;None" _]]
- (|do [_ (set-var ?eid actual)]
- (return (&/T fixpoints nil)))
-
- [["lux;Some" etype] ["lux;None" _]]
- (check* fixpoints etype actual)
-
- [["lux;None" _] ["lux;Some" atype]]
- (check* fixpoints expected atype)
-
- [["lux;Some" etype] ["lux;Some" atype]]
- (check* fixpoints etype atype))))
-
- [["lux;VarT" ?id] _]
- (fn [state]
- (matchv ::M/objects [((set-var ?id actual) state)]
- [["lux;Right" [state* _]]]
- (return* state* (&/T fixpoints nil))
-
- [["lux;Left" _]]
- ((|do [bound (deref ?id)]
- (check* fixpoints bound actual))
- state)))
-
- [_ ["lux;VarT" ?id]]
- (fn [state]
- (matchv ::M/objects [((set-var ?id expected) state)]
- [["lux;Right" [state* _]]]
- (return* state* (&/T fixpoints nil))
+ (if (clojure.lang.Util/identical expected actual)
+ (return (&/T fixpoints nil))
+ (matchv ::M/objects [expected actual]
+ [["lux;VarT" ?eid] ["lux;VarT" ?aid]]
+ (if (.equals ^Object ?eid ?aid)
+ (return (&/T fixpoints nil))
+ (|do [ebound (fn [state]
+ (matchv ::M/objects [((deref ?eid) state)]
+ [["lux;Right" [state* ebound]]]
+ (return* state* (&/V "lux;Some" ebound))
+
+ [["lux;Left" _]]
+ (return* state (&/V "lux;None" nil))))
+ abound (fn [state]
+ (matchv ::M/objects [((deref ?aid) state)]
+ [["lux;Right" [state* abound]]]
+ (return* state* (&/V "lux;Some" abound))
+
+ [["lux;Left" _]]
+ (return* state (&/V "lux;None" nil))))]
+ (matchv ::M/objects [ebound abound]
+ [["lux;None" _] ["lux;None" _]]
+ (|do [_ (set-var ?eid actual)]
+ (return (&/T fixpoints nil)))
+
+ [["lux;Some" etype] ["lux;None" _]]
+ (check* fixpoints etype actual)
+
+ [["lux;None" _] ["lux;Some" atype]]
+ (check* fixpoints expected atype)
+
+ [["lux;Some" etype] ["lux;Some" atype]]
+ (check* fixpoints etype atype))))
+
+ [["lux;VarT" ?id] _]
+ (fn [state]
+ (matchv ::M/objects [((set-var ?id actual) state)]
+ [["lux;Right" [state* _]]]
+ (return* state* (&/T fixpoints nil))
- [["lux;Left" _]]
- ((|do [bound (deref ?id)]
- (check* fixpoints expected bound))
- state)))
+ [["lux;Left" _]]
+ ((|do [bound (deref ?id)]
+ (check* fixpoints bound actual))
+ state)))
+
+ [_ ["lux;VarT" ?id]]
+ (fn [state]
+ (matchv ::M/objects [((set-var ?id expected) state)]
+ [["lux;Right" [state* _]]]
+ (return* state* (&/T fixpoints nil))
- [["lux;AppT" [["lux;VarT" ?eid] A1]] ["lux;AppT" [["lux;VarT" ?aid] A2]]]
- (fn [state]
- (matchv ::M/objects [((|do [F1 (deref ?eid)]
- (fn [state]
- (matchv ::M/objects [((|do [F2 (deref ?aid)]
- (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2))))
- state)]
- [["lux;Right" [state* output]]]
- (return* state* output)
-
- [["lux;Left" _]]
- ((check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)
- state))))
- state)]
- [["lux;Right" [state* output]]]
- (return* state* output)
-
- [["lux;Left" _]]
- (matchv ::M/objects [((|do [F2 (deref ?aid)]
- (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
+ [["lux;Left" _]]
+ ((|do [bound (deref ?id)]
+ (check* fixpoints expected bound))
+ state)))
+
+ [["lux;AppT" [["lux;VarT" ?eid] A1]] ["lux;AppT" [["lux;VarT" ?aid] A2]]]
+ (fn [state]
+ (matchv ::M/objects [((|do [F1 (deref ?eid)]
+ (fn [state]
+ (matchv ::M/objects [((|do [F2 (deref ?aid)]
+ (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2))))
+ state)]
+ [["lux;Right" [state* output]]]
+ (return* state* output)
+
+ [["lux;Left" _]]
+ ((check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)
+ state))))
state)]
[["lux;Right" [state* output]]]
(return* state* output)
[["lux;Left" _]]
- ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid))
- [fixpoints** _] (check* fixpoints* A1 A2)]
- (return (&/T fixpoints** nil)))
- state))))
- ;; (|do [_ (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid))
- ;; _ (check* fixpoints A1 A2)]
- ;; (return (&/T fixpoints nil)))
-
- [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]]
- (fn [state]
- (matchv ::M/objects [((|do [F1 (deref ?id)]
- (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual))
- state)]
- [["lux;Right" [state* output]]]
- (return* state* output)
-
- [["lux;Left" _]]
- ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2)
- e* (apply-type F2 A1)
- a* (apply-type F2 A2)
- [fixpoints** _] (check* fixpoints* e* a*)]
- (return (&/T fixpoints** nil)))
- state)))
- ;; [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]]
- ;; (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2)
- ;; e* (apply-type F2 A1)
- ;; a* (apply-type F2 A2)
- ;; [fixpoints** _] (check* fixpoints* e* a*)]
- ;; (return (&/T fixpoints** nil)))
-
- [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]]
- (fn [state]
- (matchv ::M/objects [((|do [F2 (deref ?id)]
- (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
- state)]
- [["lux;Right" [state* output]]]
- (return* state* output)
-
- [["lux;Left" _]]
- ((|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id))
- e* (apply-type F1 A1)
- a* (apply-type F1 A2)
- [fixpoints** _] (check* fixpoints* e* a*)]
- (return (&/T fixpoints** nil)))
- state)))
- ;; [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]]
- ;; (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id))
- ;; e* (apply-type F1 A1)
- ;; a* (apply-type F1 A2)
- ;; [fixpoints** _] (check* fixpoints* e* a*)]
- ;; (return (&/T fixpoints** nil)))
-
- [["lux;AppT" [F A]] _]
- (let [fp-pair (&/T expected actual)
- _ (when (> (&/|length fixpoints) 40)
- (println 'FIXPOINTS (->> (&/|keys fixpoints)
- (&/|map (fn [pair]
- (|let [[e a] pair]
- (str (show-type e) ":+:"
- (show-type a)))))
- (&/|interpose "\n\n")
- (&/fold str "")))
- (assert false))]
- (matchv ::M/objects [(fp-get fp-pair fixpoints)]
- [["lux;Some" ?]]
- (if ?
- (return (&/T fixpoints nil))
- (fail (check-error expected actual)))
-
- [["lux;None" _]]
- (|do [expected* (apply-type F A)]
- (check* (fp-put fp-pair true fixpoints) expected* actual))))
-
- [_ ["lux;AppT" [F A]]]
- (|do [actual* (apply-type F A)]
- (check* fixpoints expected actual*))
-
- [["lux;AllT" _] _]
- (with-var
- (fn [$arg]
- (|do [expected* (apply-type expected $arg)]
- (check* fixpoints expected* actual))))
-
- [_ ["lux;AllT" _]]
- (with-var
- (fn [$arg]
- (|do [actual* (apply-type actual $arg)]
- (check* fixpoints expected actual*))))
-
- [["lux;DataT" "boolean"] ["lux;DataT" "java.lang.Boolean"]]
- (return (&/T fixpoints nil))
+ (matchv ::M/objects [((|do [F2 (deref ?aid)]
+ (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
+ state)]
+ [["lux;Right" [state* output]]]
+ (return* state* output)
+
+ [["lux;Left" _]]
+ ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid))
+ [fixpoints** _] (check* fixpoints* A1 A2)]
+ (return (&/T fixpoints** nil)))
+ state))))
+ ;; (|do [_ (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid))
+ ;; _ (check* fixpoints A1 A2)]
+ ;; (return (&/T fixpoints nil)))
+
+ [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]]
+ (fn [state]
+ (matchv ::M/objects [((|do [F1 (deref ?id)]
+ (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual))
+ state)]
+ [["lux;Right" [state* output]]]
+ (return* state* output)
- [["lux;DataT" "byte"] ["lux;DataT" "java.lang.Byte"]]
- (return (&/T fixpoints nil))
+ [["lux;Left" _]]
+ ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2)
+ e* (apply-type F2 A1)
+ a* (apply-type F2 A2)
+ [fixpoints** _] (check* fixpoints* e* a*)]
+ (return (&/T fixpoints** nil)))
+ state)))
+ ;; [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]]
+ ;; (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2)
+ ;; e* (apply-type F2 A1)
+ ;; a* (apply-type F2 A2)
+ ;; [fixpoints** _] (check* fixpoints* e* a*)]
+ ;; (return (&/T fixpoints** nil)))
+
+ [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]]
+ (fn [state]
+ (matchv ::M/objects [((|do [F2 (deref ?id)]
+ (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
+ state)]
+ [["lux;Right" [state* output]]]
+ (return* state* output)
- [["lux;DataT" "short"] ["lux;DataT" "java.lang.Short"]]
- (return (&/T fixpoints nil))
+ [["lux;Left" _]]
+ ((|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id))
+ e* (apply-type F1 A1)
+ a* (apply-type F1 A2)
+ [fixpoints** _] (check* fixpoints* e* a*)]
+ (return (&/T fixpoints** nil)))
+ state)))
+ ;; [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]]
+ ;; (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id))
+ ;; e* (apply-type F1 A1)
+ ;; a* (apply-type F1 A2)
+ ;; [fixpoints** _] (check* fixpoints* e* a*)]
+ ;; (return (&/T fixpoints** nil)))
+
+ [["lux;AppT" [F A]] _]
+ (let [fp-pair (&/T expected actual)
+ _ (when (> (&/|length fixpoints) 40)
+ (println 'FIXPOINTS (->> (&/|keys fixpoints)
+ (&/|map (fn [pair]
+ (|let [[e a] pair]
+ (str (show-type e) ":+:"
+ (show-type a)))))
+ (&/|interpose "\n\n")
+ (&/fold str "")))
+ (assert false))]
+ (matchv ::M/objects [(fp-get fp-pair fixpoints)]
+ [["lux;Some" ?]]
+ (if ?
+ (return (&/T fixpoints nil))
+ (fail (check-error expected actual)))
+
+ [["lux;None" _]]
+ (|do [expected* (apply-type F A)]
+ (check* (fp-put fp-pair true fixpoints) expected* actual))))
+
+ [_ ["lux;AppT" [F A]]]
+ (|do [actual* (apply-type F A)]
+ (check* fixpoints expected actual*))
+
+ [["lux;AllT" _] _]
+ (with-var
+ (fn [$arg]
+ (|do [expected* (apply-type expected $arg)]
+ (check* fixpoints expected* actual))))
+
+ [_ ["lux;AllT" _]]
+ (with-var
+ (fn [$arg]
+ (|do [actual* (apply-type actual $arg)]
+ (check* fixpoints expected actual*))))
+
+ [["lux;DataT" "boolean"] ["lux;DataT" "java.lang.Boolean"]]
+ (return (&/T fixpoints nil))
- [["lux;DataT" "int"] ["lux;DataT" "java.lang.Integer"]]
- (return (&/T fixpoints nil))
+ [["lux;DataT" "byte"] ["lux;DataT" "java.lang.Byte"]]
+ (return (&/T fixpoints nil))
- [["lux;DataT" "long"] ["lux;DataT" "java.lang.Long"]]
- (return (&/T fixpoints nil))
+ [["lux;DataT" "short"] ["lux;DataT" "java.lang.Short"]]
+ (return (&/T fixpoints nil))
- [["lux;DataT" "float"] ["lux;DataT" "java.lang.Float"]]
- (return (&/T fixpoints nil))
+ [["lux;DataT" "int"] ["lux;DataT" "java.lang.Integer"]]
+ (return (&/T fixpoints nil))
- [["lux;DataT" "double"] ["lux;DataT" "java.lang.Double"]]
- (return (&/T fixpoints nil))
+ [["lux;DataT" "long"] ["lux;DataT" "java.lang.Long"]]
+ (return (&/T fixpoints nil))
- [["lux;DataT" "char"] ["lux;DataT" "java.lang.Character"]]
- (return (&/T fixpoints nil))
+ [["lux;DataT" "float"] ["lux;DataT" "java.lang.Float"]]
+ (return (&/T fixpoints nil))
- [["lux;DataT" "java.lang.Boolean"] ["lux;DataT" "boolean"]]
- (return (&/T fixpoints nil))
+ [["lux;DataT" "double"] ["lux;DataT" "java.lang.Double"]]
+ (return (&/T fixpoints nil))
- [["lux;DataT" "java.lang.Byte"] ["lux;DataT" "byte"]]
- (return (&/T fixpoints nil))
+ [["lux;DataT" "char"] ["lux;DataT" "java.lang.Character"]]
+ (return (&/T fixpoints nil))
- [["lux;DataT" "java.lang.Short"] ["lux;DataT" "short"]]
- (return (&/T fixpoints nil))
+ [["lux;DataT" "java.lang.Boolean"] ["lux;DataT" "boolean"]]
+ (return (&/T fixpoints nil))
- [["lux;DataT" "java.lang.Integer"] ["lux;DataT" "int"]]
- (return (&/T fixpoints nil))
+ [["lux;DataT" "java.lang.Byte"] ["lux;DataT" "byte"]]
+ (return (&/T fixpoints nil))
- [["lux;DataT" "java.lang.Long"] ["lux;DataT" "long"]]
- (return (&/T fixpoints nil))
+ [["lux;DataT" "java.lang.Short"] ["lux;DataT" "short"]]
+ (return (&/T fixpoints nil))
- [["lux;DataT" "java.lang.Float"] ["lux;DataT" "float"]]
- (return (&/T fixpoints nil))
+ [["lux;DataT" "java.lang.Integer"] ["lux;DataT" "int"]]
+ (return (&/T fixpoints nil))
- [["lux;DataT" "java.lang.Double"] ["lux;DataT" "double"]]
- (return (&/T fixpoints nil))
+ [["lux;DataT" "java.lang.Long"] ["lux;DataT" "long"]]
+ (return (&/T fixpoints nil))
- [["lux;DataT" "java.lang.Character"] ["lux;DataT" "char"]]
- (return (&/T fixpoints nil))
+ [["lux;DataT" "java.lang.Float"] ["lux;DataT" "float"]]
+ (return (&/T fixpoints nil))
- [["lux;DataT" e!name] ["lux;DataT" a!name]]
- (if (or (= e!name a!name)
- (.isAssignableFrom (Class/forName e!name) (Class/forName a!name)))
+ [["lux;DataT" "java.lang.Double"] ["lux;DataT" "double"]]
(return (&/T fixpoints nil))
- (fail (str "[Type Error] Names don't match: " e!name " & " a!name)))
-
- [["lux;LambdaT" [eI eO]] ["lux;LambdaT" [aI aO]]]
- (|do [[fixpoints* _] (check* fixpoints aI eI)]
- (check* fixpoints* eO aO))
-
- [["lux;TupleT" e!members] ["lux;TupleT" a!members]]
- (|do [fixpoints* (&/fold2% (fn [fp e a]
- (|do [[fp* _] (check* fp e a)]
- (return fp*)))
- fixpoints
- e!members a!members)]
- (return (&/T fixpoints* nil)))
-
- [["lux;VariantT" e!cases] ["lux;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]
- (if (= e!name a!name)
- (|do [[fp* _] (check* fp e!type a!type)]
- (return fp*))
- (fail (check-error expected actual)))))
- fixpoints
- e!cases a!cases)]
- (return (&/T fixpoints* nil)))
-
- [["lux;RecordT" e!slots] ["lux;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]
- (if (= e!name a!name)
- (|do [[fp* _] (check* fp e!type a!type)]
- (return fp*))
- (fail (check-error expected actual)))))
- fixpoints
- e!slots a!slots)]
- (return (&/T fixpoints* nil)))
-
- [["lux;ExT" e!id] ["lux;ExT" a!id]]
- (if (= e!id a!id)
+
+ [["lux;DataT" "java.lang.Character"] ["lux;DataT" "char"]]
(return (&/T fixpoints nil))
- (check-error expected actual))
- [_ _]
- (fail (println-str "[Type Error] Can't type-check: " (show-type expected) (show-type actual)))
- ))
+ [["lux;DataT" e!name] ["lux;DataT" a!name]]
+ (if (or (.equals ^Object e!name a!name)
+ (.isAssignableFrom (Class/forName e!name) (Class/forName a!name)))
+ (return (&/T fixpoints nil))
+ (fail (str "[Type Error] Names don't match: " e!name " & " a!name)))
+
+ [["lux;LambdaT" [eI eO]] ["lux;LambdaT" [aI aO]]]
+ (|do [[fixpoints* _] (check* fixpoints aI eI)]
+ (check* fixpoints* eO aO))
+
+ [["lux;TupleT" e!members] ["lux;TupleT" a!members]]
+ (|do [fixpoints* (&/fold2% (fn [fp e a]
+ (|do [[fp* _] (check* fp e a)]
+ (return fp*)))
+ fixpoints
+ e!members a!members)]
+ (return (&/T fixpoints* nil)))
+
+ [["lux;VariantT" e!cases] ["lux;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]
+ (if (.equals ^Object e!name a!name)
+ (|do [[fp* _] (check* fp e!type a!type)]
+ (return fp*))
+ (fail (check-error expected actual)))))
+ fixpoints
+ e!cases a!cases)]
+ (return (&/T fixpoints* nil)))
+
+ [["lux;RecordT" e!slots] ["lux;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]
+ (if (.equals ^Object e!name a!name)
+ (|do [[fp* _] (check* fp e!type a!type)]
+ (return fp*))
+ (fail (check-error expected actual)))))
+ fixpoints
+ e!slots a!slots)]
+ (return (&/T fixpoints* nil)))
+
+ [["lux;ExT" e!id] ["lux;ExT" a!id]]
+ (if (.equals ^Object e!id a!id)
+ (return (&/T fixpoints nil))
+ (check-error expected actual))
+
+ [_ _]
+ (fail (println-str "[Type Error] Can't type-check: " (show-type expected) (show-type actual)))
+ )))
(defn check [expected actual]
(|do [_ (check* init-fixpoints expected actual)]
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-13 03:38:02 +0000