aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/type/check.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/lux/type/check.lux')
-rw-r--r--stdlib/source/lux/type/check.lux46
1 files changed, 23 insertions, 23 deletions
diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux
index 42479451c..ce0545caa 100644
--- a/stdlib/source/lux/type/check.lux
+++ b/stdlib/source/lux/type/check.lux
@@ -10,31 +10,31 @@
["." product]
["." error (#+ Error)]
[number
- ["." nat ("#/." decimal)]]
- ["." text ("#/." monoid equivalence)]
+ ["." nat ("#;." decimal)]]
+ ["." text ("#;." monoid equivalence)]
[collection
["." list]
["." set (#+ Set)]]]]
- ["." // ("#/." equivalence)])
+ ["." // ("#;." equivalence)])
(template: (!n/= reference subject)
("lux i64 =" subject reference))
-(template: (!text/= reference subject)
+(template: (!text;= reference subject)
("lux text =" subject reference))
(exception: #export (unknown-type-var {id Nat})
- (ex.report ["ID" (nat/encode id)]))
+ (ex.report ["ID" (nat;encode id)]))
(exception: #export (unbound-type-var {id Nat})
- (ex.report ["ID" (nat/encode id)]))
+ (ex.report ["ID" (nat;encode id)]))
(exception: #export (invalid-type-application {funcT Type} {argT Type})
(ex.report ["Type function" (//.to-text funcT)]
["Type argument" (//.to-text argT)]))
(exception: #export (cannot-rebind-var {id Nat} {type Type} {bound Type})
- (ex.report ["Var" (nat/encode id)]
+ (ex.report ["Var" (nat;encode id)]
["Wanted Type" (//.to-text type)]
["Current Type" (//.to-text bound)]))
@@ -104,7 +104,7 @@
)))
)
-(open: "check/." ..monad)
+(open: "check;." ..monad)
(def: (var::get id plist)
(-> Var Type-Vars (Maybe (Maybe Type)))
@@ -253,7 +253,7 @@
_
(case (//.apply (list argT) funcT)
(#.Some output)
- (check/wrap output)
+ (check;wrap output)
_
(throw invalid-type-application [funcT argT]))))
@@ -327,8 +327,8 @@
(def: (assumed? [e a] assumptions)
(-> Assumption (List Assumption) Bit)
(list.any? (function (_ [e' a'])
- (and (///= e e')
- (///= a a')))
+ (and (//;= e e')
+ (//;= a a')))
assumptions))
(def: (assume! assumption assumptions)
@@ -374,7 +374,7 @@
Var Var
(Check (List Assumption)))
(if (!n/= idE idA)
- (check/wrap assumptions)
+ (check;wrap assumptions)
(do ..monad
[ebound (attempt (peek idE))
abound (attempt (peek idA))]
@@ -447,7 +447,7 @@
(on-error [])
_
- ($_ text/compose
+ ($_ text;compose
(on-error [])
text.new-line text.new-line
"-----------------------------------------"
@@ -514,7 +514,7 @@
{#.doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."}
(-> (List Assumption) Type Type (Check (List Assumption)))
(if (is? expected actual)
- (check/wrap assumptions)
+ (check;wrap assumptions)
(with-error-stack
(function (_ _) (ex.construct type-check-failed [expected actual]))
(case [expected actual]
@@ -523,13 +523,13 @@
[(#.Var id) _]
(if-bind id actual
- (check/wrap assumptions)
+ (check;wrap assumptions)
(function (_ bound)
(check' assumptions bound actual)))
[_ (#.Var id)]
(if-bind id expected
- (check/wrap assumptions)
+ (check;wrap assumptions)
(function (_ bound)
(check' assumptions expected bound)))
@@ -544,7 +544,7 @@
[(#.Apply A F) _]
(let [new-assumption [expected actual]]
(if (assumed? new-assumption assumptions)
- (check/wrap assumptions)
+ (check;wrap assumptions)
(do ..monad
[expected' (apply-type! F A)]
(check' (assume! new-assumption assumptions) expected' actual))))
@@ -575,13 +575,13 @@
[#.ExQ ..existential])
[(#.Primitive e-name e-params) (#.Primitive a-name a-params)]
- (if (!text/= e-name a-name)
+ (if (!text;= e-name a-name)
(loop [assumptions assumptions
e-params e-params
a-params a-params]
(case [e-params a-params]
[#.Nil #.Nil]
- (check/wrap assumptions)
+ (check;wrap assumptions)
[(#.Cons e-head e-tail) (#.Cons a-head a-tail)]
(do ..monad
@@ -607,7 +607,7 @@
[(#.Ex e!id) (#.Ex a!id)]
(if (!n/= e!id a!id)
- (check/wrap assumptions)
+ (check;wrap assumptions)
(fail ""))
[(#.Named _ ?etype) _]
@@ -645,17 +645,17 @@
(#.Primitive name paramsT+)
(|> paramsT+
(monad.map ..monad clean)
- (check/map (|>> (#.Primitive name))))
+ (check;map (|>> (#.Primitive name))))
(^or (#.Parameter _) (#.Ex _) (#.Named _))
- (check/wrap inputT)
+ (check;wrap inputT)
(^template [<tag>]
(<tag> leftT rightT)
(do ..monad
[leftT' (clean leftT)]
(|> (clean rightT)
- (check/map (|>> (<tag> leftT'))))))
+ (check;map (|>> (<tag> leftT'))))))
([#.Sum] [#.Product] [#.Function] [#.Apply])
(#.Var id)