module Ivory.Compile.C.Modules where
import Paths_ivory_backend_c (version)
import Prelude ()
import Prelude.Compat
import Text.PrettyPrint.Mainland
#if MIN_VERSION_mainland_pretty(0,6,0)
import Text.PrettyPrint.Mainland.Class
#endif
import qualified Ivory.Language.Syntax.AST as I
import Ivory.Compile.C.Gen
import Ivory.Compile.C.Types
import Control.Monad (unless, when)
import Data.Char (toUpper)
import Data.Maybe (fromJust, isJust)
import Data.Version (showVersion)
import MonadLib (put, runM)
import System.FilePath.Posix ((<.>))
showModule :: CompileUnits -> String
showModule m = unlines $ map unlines $
[ mk (lbl "Source") (sources m)
, mk (lbl "Header") (headers m)
]
where
lbl l = "// module " ++ unitName m ++ " " ++ l ++ ":\n"
mk _ (_,[]) = []
mk str (incls,units) = str : pp (mkDefs (incls, units))
pp = map (pretty maxWidth . ppr)
compilerVersion :: String
compilerVersion = showVersion version
topComments :: Doc
topComments = text "/* This file has been autogenerated by Ivory" </>
text " * Compiler version " <+> text compilerVersion </>
text " */"
renderHdr :: (Includes, Sources) -> String -> String
renderHdr s unitname = displayS (render maxWidth guardedHeader) ""
where
guardedHeader = stack [ topComments
, topGuard
, topExternC
, ppr (mkDefs s)
, botExternC
, botGuard
]
topGuard = text "#ifndef" <+> guardName </> text "#define"
<+> guardName
botGuard = text "#endif" <+> text "/*" <+> guardName <+> text "*/\n"
unitname' = map (\c -> if c == '-' then '_' else c) unitname
guardName = text "__" <> text (toUpper <$> unitname') <> text "_H__"
topExternC = stack $ text <$> [ "#ifdef __cplusplus"
, "extern \"C\" {"
, "#endif"]
botExternC = stack $ text <$> [ "#ifdef __cplusplus"
, "}"
, "#endif"]
renderSrc :: (Includes, Sources) -> String
renderSrc s = displayS (render maxWidth srcdoc) ""
where
srcdoc = topComments </> out </> text ""
out = stack $ punctuate line $ map ppr $ mkDefs s
runOpt :: (I.Proc -> I.Proc) -> I.Module -> I.Module
runOpt opt m =
m { I.modProcs = procs' }
where
procs' = procs { I.public = map' I.public, I.private = map' I.private }
procs = I.modProcs m
map' acc = map opt (acc procs)
compileModule :: Maybe String -> I.Module -> CompileUnits
compileModule hdr I.Module { I.modName = nm
, I.modDepends = deps
, I.modHeaders = hdrs
, I.modImports = imports
, I.modExterns = externs
, I.modProcs = procs
, I.modStructs = structs
, I.modAreas = areas
, I.modAreaImports = ais
}
= CompileUnits
{ unitName = nm
, sources = sources res
, headers = headers res
}
where
res = compRes comp
compRes = (snd . runM . unCompile)
unitHdr = LocalInclude (nm <.> "h")
comp = do
let c = compRes comp0
unless (null (snd (headers c))) (putSrcInc unitHdr)
Compile (put c)
comp0 :: Compile
comp0 = do
putHdrInc (LocalInclude "ivory.h")
when (isJust hdr)
(putHdrInc (LocalInclude (fromJust hdr)))
mapM_ (putHdrInc . LocalInclude . ((<.> "h"))) deps
mapM_ (putHdrInc . LocalInclude) hdrs
mapM_ (compileStruct Public) (I.public structs)
mapM_ (compileStruct Private) (I.private structs)
mapM_ fromImport imports
mapM_ fromExtern externs
mapM_ (extractAreaProto Public) (I.public areas)
mapM_ (extractAreaProto Private) (I.private areas)
mapM_ (compileArea Public) (I.public areas)
mapM_ (compileArea Private) (I.private areas)
mapM_ compileAreaImport ais
mapM_ (extractProto Public) (I.public procs)
mapM_ (extractProto Private) (I.private procs)
mapM_ compileUnit (I.public procs ++ I.private procs)
fromImport :: I.Import -> Compile
fromImport p = putHdrInc (SysInclude (I.importFile p))
fromExtern :: I.Extern -> Compile
fromExtern p = putHdrInc (SysInclude (I.externFile p))
outputProcSyms :: [I.Module] -> IO ()
outputProcSyms mods = putStrLn $ unwords $ concatMap go mods
where
go :: I.Module -> [String]
go m = map I.procSym (pub ++ priv)
where I.Visible pub priv = I.modProcs m
maxWidth :: Int
maxWidth = 400
mkDefs :: ([Include], Sources) -> Sources
mkDefs (incls, defs) = map includeDef incls ++ defs