module FreeC.Backend
( Backend(..)
, BackendConverter
, backends
, showBackends
, defaultBackend
) where
import Control.Monad.Extra ( unlessM, whenM )
import Control.Monad.IO.Class
import Data.List ( intercalate )
import qualified Data.Map.Strict as Map
import Data.Maybe ( isJust )
import System.Directory
( createDirectoryIfMissing, doesFileExist, makeAbsolute )
import System.FilePath
import FreeC.Application.Options
import qualified FreeC.Backend.Agda.Converter.Module as Agda.Converter
import FreeC.Backend.Agda.Pretty ()
import qualified FreeC.Backend.Coq.Base as Coq.Base
import qualified FreeC.Backend.Coq.Converter.Module as Coq.Converter
import FreeC.Backend.Coq.Pretty ()
import FreeC.IR.Strip ( stripExprType )
import qualified FreeC.IR.Syntax as IR
import FreeC.Monad.Application
import FreeC.Pretty ( showPretty )
type BackendConverter = IR.Module -> Application String
data Backend = Backend
{ backendName :: String
, backendConvertModule :: BackendConverter
, backendFileExtension :: String
, backendSpecialAction :: Application ()
}
backends :: Map.Map String Backend
backends = Map.fromList
[(backendName b, b) | b <- [coqBackend, irBackend, agdaBackend]]
showBackends :: String
showBackends = '`' : intercalate "`, `" (Map.keys backends) ++ "`"
defaultBackend :: String
defaultBackend = backendName coqBackend
irBackend :: Backend
irBackend = Backend
{ backendName = "ir"
, backendConvertModule = return . showPretty . stripExprType
, backendFileExtension = "ir"
, backendSpecialAction = return ()
}
convertModuleToCoq :: IR.Module -> Application String
convertModuleToCoq
= fmap showPretty . liftConverter . Coq.Converter.convertModule
createCoqProject :: Application ()
createCoqProject
= whenM coqProjectEnabled $ unlessM coqProjectExists writeCoqProject
where
coqProjectEnabled :: Application Bool
coqProjectEnabled = do
isEnabled <- inOpts optCreateCoqProject
maybeOutputDir <- inOpts optOutputDir
return (isEnabled && isJust maybeOutputDir)
getCoqProjectFile :: Application FilePath
getCoqProjectFile = do
Just outputDir <- inOpts optOutputDir
return (outputDir </> "_CoqProject")
coqProjectExists :: Application Bool
coqProjectExists = getCoqProjectFile >>= liftIO . doesFileExist
writeCoqProject :: Application ()
writeCoqProject = do
coqProject <- getCoqProjectFile
contents <- makeContents
liftIO $ do
createDirectoryIfMissing True (takeDirectory coqProject)
writeFile coqProject contents
makeContents :: Application String
makeContents = do
baseDir <- inOpts optBaseLibDir
let coqBaseDir = baseDir </> "coq"
Just outputDir <- inOpts optOutputDir
absBaseDir <- liftIO $ makeAbsolute coqBaseDir
absOutputDir <- liftIO $ makeAbsolute outputDir
let relBaseDir = makeRelative absOutputDir absBaseDir
return
$ unlines [ "-R " ++ relBaseDir ++ " " ++ showPretty Coq.Base.baseLibName
, "-R . " ++ showPretty Coq.Base.generatedLibName
]
coqBackend :: Backend
coqBackend = Backend { backendName = "coq"
, backendConvertModule = convertModuleToCoq
, backendFileExtension = "v"
, backendSpecialAction = createCoqProject
}
convertModuleToAgda :: IR.Module -> Application String
convertModuleToAgda
= fmap showPretty . liftConverter . Agda.Converter.convertModule
createAgdaLib :: Application ()
createAgdaLib = whenM agdaLibEnabled $ unlessM agdaLibExists $ do
(agdaLib, name) <- getAgdaLib
liftIO $ do
createDirectoryIfMissing True (takeDirectory agdaLib)
writeFile agdaLib $ contents name
where
agdaLibEnabled :: Application Bool
agdaLibEnabled = do
isEnabled <- inOpts optCreateAgdaLib
maybeOutputDir <- inOpts optOutputDir
return $ isEnabled && isJust maybeOutputDir
agdaLibExists :: Application Bool
agdaLibExists = getAgdaLib >>= liftIO . doesFileExist . fst
contents :: String -> String
contents name
= unlines ["name: " ++ name, "include: .", "depend: standard-library base"]
getAgdaLib :: Application (FilePath, String)
getAgdaLib = do
Just outputDir <- inOpts optOutputDir
name <- liftIO $ last . splitDirectories <$> makeAbsolute outputDir
return (outputDir </> (name ++ ".agda-lib"), name)
agdaBackend :: Backend
agdaBackend = Backend { backendName = "agda"
, backendConvertModule = convertModuleToAgda
, backendFileExtension = "agda"
, backendSpecialAction = createAgdaLib
}