diff options
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/common.lux | 5 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation.lux | 39 | ||||
| -rw-r--r-- | stdlib/source/lux/meta/type/check.lux | 38 |
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]) + )) |