aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/translation.lux40
1 files changed, 40 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux
index cf3137aff..6726470cc 100644
--- a/new-luxc/source/luxc/lang/translation.lux
+++ b/new-luxc/source/luxc/lang/translation.lux
@@ -8,6 +8,7 @@
text/format
(coll [dict]))
[meta]
+ (meta (type ["tc" check]))
[host]
[io]
(world [file #+ File]))
@@ -35,6 +36,43 @@
(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: (translate code)
(-> Code (Meta Unit))
(case code
@@ -55,6 +93,8 @@
(wrap [Type valueA]))
(commonA;with-unknown-type
(analyse valueC))))
+ valueT (&;with-type-env
+ (clean valueT))
valueI (expressionT;translate (expressionS;synthesize valueA))
_ (&;with-scope
(statementT;translate-def def-name valueT valueI metaI (:! Code metaV)))]