futhask-1.0.0: app/Main.hs

{-# LANGUAGE OverloadedStrings, MultilineStrings #-}

module Main where


import System.IO
import Data.Maybe
import Data.Text (Text)
import Data.Version
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as T
import qualified Data.ByteString as B
import Text.ParserCombinators.ReadP as P
import Data.List (intercalate)
import Debug.Trace
import System.Directory
import System.Environment
import Headers
import Backends
import qualified Futhark.Manifest as FM
import qualified CodeGen as M
import qualified CabalGen as CG
import Context
import Monad 

main :: IO ()
main = do
    args     <- getArgs
    if length args == 5 
        then do
            libname  <- pure (args !! 0)
            libver   <- pure (args !! 1)
            cfile    <- pure (args !! 2)
            mfile    <- pure (args !! 3)
            dest     <- pure (args !! 4)
            manifest <- M.readManifest mfile
            makelibrary (T.pack libname) (T.pack libver) (dest <> "/") cfile manifest
        else M.putText 
            """
            Invalid number of arguments - futhask takes exactly 5 arguments:
            \tLIBNAME      - name of library to be generated
            \tLIBVER       - version of library to be generated
            \tPROGRAM.c    - C file generated by `futhark backend PROGRAM.fut --library`
            \tPROGRAM.json - manifest file generated by `futhark backend PROGRAM.fut --library`
            \tDEST         - location of the generated library
            """

makelibrary name libver pacdir program manifest = do
    checkManifestVersion
    backend <- pure $ case FM.manifestBackend manifest of
                "c"         -> C
                "multicore" -> Multicore
                "opencl"    -> OpenCL
                "cuda"      -> Cuda
                "hip"       -> Hip 

    createDirectoryIfMissing False pacdir
    createDirectoryIfMissing False srcdir
    createDirectoryIfMissing False libdir
    createDirectoryIfMissing False rawdir
    createDirectoryIfMissing False natdir
    createDirectoryIfMissing False unpdir
    copyFile program (pacdir <> "/src.c")
    T.writeFile (pacdir <> T.unpack name <> ".cabal") 
        (CG.cabalFile futhaskVersion futhaskBaseVersion name libname libver backend)
    T.writeFile (srcdir <> T.unpack libname <> ".hs") $ exports
    T.writeFile (rawdir <> "Context.hs") $ rawContext
    T.writeFile (rawdir <> "Types.hs") $ rawTypes
    T.writeFile (rawdir <> "TypeDec.hs") $ rawTypeDec
    T.writeFile (rawdir <> "TypeOps.hs") $ rawTypeOps
    T.writeFile (rawdir <> "EntryPoints.hs") $ rawEntryPoints
    T.writeFile (libdir <> "Raw.hs") $ rawExports
    T.writeFile (libdir <> "Context.hs") $ context
    T.writeFile (libdir <> "Monad.hs") $ monad
    T.writeFile (libdir <> "Types.hs") $ types
    T.writeFile (libdir <> "TypeDec.hs") $ typeDec
    T.writeFile (libdir <> "TypeOps.hs") $ typeOps
    T.writeFile (libdir <> "EntryPoints.hs") $ entryPoints
    T.writeFile (libdir <> "Conversion.hs") $ conversion
    T.writeFile (natdir <> "Types.hs") $ nativeTypes
    T.writeFile (unpdir <> "Types.hs") $ unpackedTypes
    where
        futhaskVersion = "1.0.0.0"
        futhaskBaseVersion = "0.1.0.0"
        --name = "testlib"
        --libver = "0.1"
        --pacdir = "../testlibrary/"
        --program = "test.c"
        --manifestFile = "test.json"
        libname = M.capitalize name
        srcdir = pacdir <> "src/" 
        libdir = srcdir <> T.unpack libname <> "/"
        rawdir = libdir <> "Raw/"
        natdir = libdir <> "Native/"
        unpdir = libdir <> "Unpacked/"
        readVersion = fst . head . P.readP_to_S parseVersion . T.unpack
        manifestVersionLowerBound = readVersion "0.27" 
        manifestVersionUpperBound = readVersion "1.0"
        checkManifestVersion = 
            let version = readVersion (FM.manifestVersion manifest)
            in if version < manifestVersionLowerBound 
                then error ("Manifest version " <> show version <> " is too old. Use newer futhark compiler.")
                else if version > manifestVersionUpperBound 
                    then putStrLn ("WARNING: Manifest version " <> show version <> " is newer than what has been tested for this version of Futhask.")
                    else pure ()
        exports = exportsHeader libname
        rawContext = rawContextHeader libname <> rawContextDec manifest
        rawTypes = rawTypesHeader libname 
        rawTypeDec = rawTypeDecHeader libname <> M.rawTypeDecs manifest 
        rawTypeOps = rawTypeOpsHeader libname <> M.rawTypeOpss manifest 
        rawEntryPoints = rawEntryPointsHeader libname <> M.rawEntryCalls manifest
        rawExports = rawHeader libname
        nativeTypes = nativeTypesHeader libname <> M.nativeTypeDecs manifest
        unpackedTypes = unpackedTypesHeader libname <> M.unpackedTypeDecs manifest
        context = contextHeader libname <> wrappedContextDec manifest
        monad = monadHeader libname <> monadBody manifest
        types = typesHeader libname
        typeDec = typeDecHeader libname <> M.wrappedTypeDecs manifest
        typeOps = typeOpsHeader libname <> M.wrappedTypeOpss manifest
        entryPoints = entryPointsHeader libname <> M.wrappedEntryCalls manifest
        conversion = conversionHeader libname <> M.conversionDecs manifest