diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation.lux')
| -rw-r--r-- | new-luxc/source/luxc/lang/translation.lux | 40 |
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)))] |