module DDC.Build.Interface.Base ( Interface (..) , makeInterfaceTearLine , takeInterfaceTearLine , isInterfaceTearLine) where import DDC.Core.Module import DDC.Core.Pretty import DDC.Core.Exp.Annot import Data.Maybe import Data.Time.Clock import qualified Data.Char as Char import qualified DDC.Core.Tetra as Tetra import qualified DDC.Core.Salt as Salt --------------------------------------------------------------------------------------------------- -- | Module interface. data Interface ta sa = Interface { -- | Path that the interface was loaded from. interfaceFilePath :: FilePath -- | Last modification time of the interface file, -- used to determine when the source needs to be rebuilt. , interfaceTimeStamp :: UTCTime , interfaceVersion :: String , interfaceModuleName :: ModuleName , interfaceTetraModule :: Maybe (Module ta Tetra.Name) , interfaceSaltModule :: Maybe (Module sa Salt.Name) } --------------------------------------------------------------------------------------------------- instance Pretty (Interface ta sa) where ppr i = (text "ddc interface" <+> text (interfaceVersion i)) <> line <> line <> vcat [ text $ makeInterfaceTearLine "Meta" , text "module-meta" <+> lbrace <> line <> indent 8 (vcat [ hsep [text "name:", ppr $ interfaceModuleName i ] ]) <> line <> rbrace] -- Include the full unoptimised core code in interface files. -- We include the unoptimised code so that the modules that inline -- functions from this one are not sensitive to the optimisation flags -- use here. If we included the optimised code it would make it harder -- to reason about the overall compilation process. <> (case interfaceTetraModule i of Just m -> vcat [ line , text $ makeInterfaceTearLine "Tetra" , ppr m ] Nothing -> empty) -- Include the header of the Salt module. -- We don't need the function definitions because inlining is performed -- using the higher level Tetra code. <> (case interfaceSaltModule i of Just m -> -- zap the module body so we don't get the function definitions. let m' = m { moduleBody = xUnit (annotOfExp $ moduleBody m) } in vcat [ line , text $ makeInterfaceTearLine "Salt" , ppr m' ] Nothing -> empty) --------------------------------------------------------------------------------------------------- -- | Tear line to separate sections of the interface file. -- We use '~' because it's not used in the core language syntax. makeInterfaceTearLine :: String -> String makeInterfaceTearLine name = "~~ " ++ name ++ " " ++ replicate (80 - 4 - length name) '~' -- | Take the name from an interface tear line, if it is one. takeInterfaceTearLine :: String -> Maybe String takeInterfaceTearLine str | '~' : '~' : ' ' : str2 <- str , (name, str3) <- span (not . Char.isSpace) str2 , (' ' : rest) <- str3 , all (== '~') rest = Just name | otherwise = Nothing -- | Check if this string is an interface tear line. isInterfaceTearLine :: String -> Bool isInterfaceTearLine str = isJust $ takeInterfaceTearLine str