aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/analysis/common.lux5
-rw-r--r--new-luxc/source/luxc/lang/translation.lux39
-rw-r--r--stdlib/source/lux/meta/type/check.lux38
3 files changed, 41 insertions, 41 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/common.lux b/new-luxc/source/luxc/lang/analysis/common.lux
index 5e618d64c..2f3e3a37d 100644
--- a/new-luxc/source/luxc/lang/analysis/common.lux
+++ b/new-luxc/source/luxc/lang/analysis/common.lux
@@ -15,8 +15,9 @@
(do meta;Monad<Meta>
[[_ varT] (&;with-type-env tc;var)
analysis (&;with-expected-type varT
- action)]
- (wrap [varT analysis])))
+ action)
+ knownT (&;with-type-env (tc;clean varT))]
+ (wrap [knownT analysis])))
(exception: #export Variant-Tag-Out-Of-Bounds)
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux
index 85eed9ba1..e573aa3ae 100644
--- a/new-luxc/source/luxc/lang/translation.lux
+++ b/new-luxc/source/luxc/lang/translation.lux
@@ -37,43 +37,6 @@
(exception: #export Macro-Expansion-Failed)
(exception: #export Unrecognized-Statement)
-(def: (clean inputT)
- (-> Type (tc;Check Type))
- (case inputT
- (#;Primitive name paramsT+)
- (do tc;Monad<Check>
- [paramsT+' (monad;map @ clean paramsT+)]
- (wrap (#;Primitive name paramsT+')))
-
- (^or #;Void #;Unit (#;Bound _) (#;Ex _) (#;Named _))
- (:: tc;Monad<Check> wrap inputT)
-
- (^template [<tag>]
- (<tag> leftT rightT)
- (do tc;Monad<Check>
- [leftT' (clean leftT)
- rightT' (clean rightT)]
- (wrap (<tag> leftT' rightT'))))
- ([#;Sum] [#;Product] [#;Function] [#;Apply])
-
- (#;Var id)
- (do tc;Monad<Check>
- [?actualT (tc;read id)]
- (case ?actualT
- (#;Some actualT)
- (clean actualT)
-
- _
- (wrap inputT)))
-
- (^template [<tag>]
- (<tag> envT+ unquantifiedT)
- (do tc;Monad<Check>
- [envT+' (monad;map @ clean envT+)]
- (wrap (<tag> envT+' unquantifiedT))))
- ([#;UnivQ] [#;ExQ])
- ))
-
(def: (process-annotations annsC)
(-> Code (Meta [$;Inst Code]))
(do meta;Monad<Meta>
@@ -101,7 +64,7 @@
(commonA;with-unknown-type
(analyse valueC))))
valueT (&;with-type-env
- (clean valueT))
+ (tc;clean valueT))
valueI (expressionT;translate (expressionS;synthesize valueA))
_ (&;with-scope
(statementT;translate-def def-name valueT valueI annsI annsV))]
diff --git a/stdlib/source/lux/meta/type/check.lux b/stdlib/source/lux/meta/type/check.lux
index 74c5a2a90..91e8f3bdf 100644
--- a/stdlib/source/lux/meta/type/check.lux
+++ b/stdlib/source/lux/meta/type/check.lux
@@ -17,7 +17,6 @@
(exception: #export Unknown-Type-Var)
(exception: #export Unbound-Type-Var)
(exception: #export Improper-Ring)
-(exception: #export Cannot-Clean-Unbound-Var)
(exception: #export Invalid-Type-Application)
(exception: #export Cannot-Rebind-Var)
(exception: #export Type-Check-Failed)
@@ -628,3 +627,40 @@
(Check Type-Context)
(function [context]
(#e;Success [context context])))
+
+(def: #export (clean inputT)
+ (-> Type (Check Type))
+ (case inputT
+ (#;Primitive name paramsT+)
+ (do Monad<Check>
+ [paramsT+' (monad;map @ clean paramsT+)]
+ (wrap (#;Primitive name paramsT+')))
+
+ (^or #;Void #;Unit (#;Bound _) (#;Ex _) (#;Named _))
+ (:: Monad<Check> wrap inputT)
+
+ (^template [<tag>]
+ (<tag> leftT rightT)
+ (do Monad<Check>
+ [leftT' (clean leftT)
+ rightT' (clean rightT)]
+ (wrap (<tag> leftT' rightT'))))
+ ([#;Sum] [#;Product] [#;Function] [#;Apply])
+
+ (#;Var id)
+ (do Monad<Check>
+ [?actualT (read id)]
+ (case ?actualT
+ (#;Some actualT)
+ (clean actualT)
+
+ _
+ (wrap inputT)))
+
+ (^template [<tag>]
+ (<tag> envT+ unquantifiedT)
+ (do Monad<Check>
+ [envT+' (monad;map @ clean envT+)]
+ (wrap (<tag> envT+' unquantifiedT))))
+ ([#;UnivQ] [#;ExQ])
+ ))