module Helium.Main.PhaseImport(phaseImport) where
import Helium.Main.CompileUtils
import qualified Lvm.Core.Expr as Core
import qualified Lvm.Core.Utils as Core
import Lvm.Common.Id(Id, stringFromId)
import Helium.Syntax.UHA_Syntax
import Helium.Syntax.UHA_Utils
import Helium.Syntax.UHA_Range(noRange)
import Lvm.Path(searchPath)
import Lvm.Import(lvmImportDecls)
import Helium.ModuleSystem.CoreToImportEnv(getImportEnvironment)
import qualified Helium.ModuleSystem.ExtractImportDecls as EID
import Data.List(isPrefixOf)
phaseImport :: String -> Module -> [String] -> [Option] ->
IO ([Core.CoreDecl], [ImportEnvironment])
phaseImport fullName module_ lvmPath options = do
enterNewPhase "Importing" options
let (_, baseName, _) = splitFilePath fullName
let moduleWithExtraImports = addImplicitImports module_
chasedImpsList <- chaseImports lvmPath moduleWithExtraImports
let indirectionDecls = concat chasedImpsList
importEnvs =
map (getImportEnvironment baseName) chasedImpsList
return (indirectionDecls, importEnvs)
chaseImports :: [String] -> Module -> IO [[Core.CoreDecl]]
chaseImports lvmPath fromModule =
let coreImports = EID.coreImportDecls_Syn_Module $ EID.wrap_Module (EID.sem_Module fromModule) EID.Inh_Module
findModule = searchPath lvmPath ".lvm" . stringFromId
doImport :: (Core.CoreDecl,[Id]) -> IO [Core.CoreDecl]
doImport (importDecl,hidings)
= do decls <- lvmImportDecls findModule [importDecl]
return [ d
| d <- concat decls
, let name = Core.declName d
, "show" `isPrefixOf` stringFromId name || name `notElem` hidings
]
in mapM doImport coreImports
addImplicitImports :: Module -> Module
addImplicitImports (Module_Module moduleRange maybeName exports
(Body_Body bodyRange explicitImportDecls decls)) =
Module_Module
moduleRange
maybeName
exports
(Body_Body
bodyRange
( case maybeName of
MaybeName_Just n
| getNameName n == "Prelude" -> []
_ -> if "Prelude" `elem` map stringFromImportDeclaration explicitImportDecls
then []
else [ implicitImportDecl "Prelude" ]
++ [ implicitImportDecl "HeliumLang" ]
++ explicitImportDecls
) decls
)
where
implicitImportDecl :: String -> ImportDeclaration
implicitImportDecl moduleName =
ImportDeclaration_Import
noRange
False
(Name_Identifier noRange [] moduleName)
MaybeName_Nothing
MaybeImportSpecification_Nothing
addImplicitImports (Module_Module _ _ _ (Body_Hole _ _)) = error "not supported"