module Helium.Main.PhaseDesugarer(phaseDesugarer) where
import Helium.Main.CompileUtils
import Text.PrettyPrint.Leijen
import Lvm.Core.Expr(CoreModule, CoreDecl)
import Lvm.Core.RemoveDead( coreRemoveDead )
import Helium.Syntax.UHA_Syntax(Name(..), MaybeName(..))
import Helium.Syntax.UHA_Range(noRange)
import Helium.ModuleSystem.ImportEnvironment()
import Helium.ModuleSystem.DictionaryEnvironment (DictionaryEnvironment)
import qualified Helium.CodeGeneration.CodeGeneration as CodeGeneration
phaseDesugarer :: DictionaryEnvironment ->
String -> Module -> [CoreDecl] ->
ImportEnvironment ->
TypeEnvironment -> [Option] -> IO CoreModule
phaseDesugarer dictionaryEnv fullName module_ extraDecls afterTypeInferEnv toplevelTypes options = do
enterNewPhase "Desugaring" options
let (path, baseName, _) = splitFilePath fullName
fullNameNoExt = combinePathAndFile path baseName
moduleWithName = fixModuleName module_ baseName
coreModule = CodeGeneration.core_Syn_Module $
CodeGeneration.wrap_Module (CodeGeneration.sem_Module moduleWithName)
CodeGeneration.Inh_Module {
CodeGeneration.dictionaryEnv_Inh_Module = dictionaryEnv,
CodeGeneration.extraDecls_Inh_Module = extraDecls,
CodeGeneration.importEnv_Inh_Module = afterTypeInferEnv,
CodeGeneration.toplevelTypes_Inh_Module = toplevelTypes }
strippedCoreModule = coreRemoveDead coreModule
when (DumpCore `elem` options) $
print . pretty $ strippedCoreModule
when (DumpCoreToFile `elem` options) $ do
writeFile (fullNameNoExt ++ ".core") $ show . pretty $ strippedCoreModule
exitSuccess
return strippedCoreModule
fixModuleName :: Module -> String -> Module
fixModuleName original@(Module_Module r name es b) baseName =
case name of
MaybeName_Nothing ->
Module_Module r (MaybeName_Just (Name_Identifier noRange [] baseName)) es b
_ -> original