content: {-# LANGUAGE CPP         #-}
  {-# LANGUAGE QuasiQuotes #-}
  
  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)
  
  --------------------------------------------------------------------------------
  
  -- | Compile a module.
  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)))
      -- module names don't have a .h on the end
      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
  
  --------------------------------------------------------------------------------
  
  -- This is generated code, and sometimes, we have large expressions. In
  -- practice, this means that once the width is reached, one token is placed per
  -- line(!). So we'll make a high limit for width, somewhat ironically making
  -- generated C more readable.
  maxWidth :: Int
  maxWidth = 400
  
  mkDefs :: ([Include], Sources) -> Sources
  mkDefs (incls, defs) = map includeDef incls ++ defs
  