aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/analysis/procedure
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/analysis/procedure')
-rw-r--r--new-luxc/source/luxc/lang/analysis/procedure/common.lux36
1 files changed, 36 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/procedure/common.lux b/new-luxc/source/luxc/lang/analysis/procedure/common.lux
index c8e3e3b38..778e57b94 100644
--- a/new-luxc/source/luxc/lang/analysis/procedure/common.lux
+++ b/new-luxc/source/luxc/lang/analysis/procedure/common.lux
@@ -151,6 +151,42 @@
[lux//check typeA;analyse-check]
[lux//coerce typeA;analyse-coerce])
+(def: (clean-type inputT)
+ (-> Type (tc;Check Type))
+ (case inputT
+ (#;Primitive name paramsT+)
+ (do tc;Monad<Check>
+ [paramsT+' (monad;map @ clean-type 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-type leftT)
+ rightT' (clean-type rightT)]
+ (wrap (<tag> leftT' rightT'))))
+ ([#;Sum] [#;Product] [#;Function] [#;Apply])
+
+ (#;Var id)
+ (do tc;Monad<Check>
+ [? (tc;concrete? id)]
+ (if ?
+ (do @
+ [actualT (tc;read id)]
+ (clean-type actualT))
+ (wrap inputT)))
+
+ (^template [<tag>]
+ (<tag> envT+ unquantifiedT)
+ (do tc;Monad<Check>
+ [envT+' (monad;map @ clean-type envT+)]
+ (wrap (<tag> envT+' unquantifiedT))))
+ ([#;UnivQ] [#;ExQ])
+ ))
+
(def: (lux//check//type proc)
(-> Text Proc)
(function [analyse eval args]