{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}

-- | C code generation for 'Program'

module Language.Embedded.Backend.C
  ( module Language.Embedded.Backend.C.Expression
  , module Language.Embedded.Backend.C
  , Default (..)
  ) where



#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
import Data.Monoid
#endif
import Control.Exception
import Data.Time (getCurrentTime, formatTime, defaultTimeLocale)
import System.Directory (getTemporaryDirectory, removeFile)
import System.Exit (ExitCode (..))
import System.IO
import System.Process (system, readProcess)

import Data.Default.Class
import Data.Loc (noLoc)
import qualified Language.C.Syntax as C
import Text.PrettyPrint.Mainland (pretty)

import Control.Monad.Operational.Higher
import System.IO.Fake
import Language.C.Monad

import Language.Embedded.Backend.C.Expression



--------------------------------------------------------------------------------
-- * Utilities
--------------------------------------------------------------------------------

-- | Create a named type
namedType :: String -> C.Type
namedType :: String -> Type
namedType String
t = DeclSpec -> Decl -> SrcLoc -> Type
C.Type
    ([Storage] -> [TypeQual] -> TypeSpec -> SrcLoc -> DeclSpec
C.DeclSpec [] [] (Id -> [Id] -> SrcLoc -> TypeSpec
C.Tnamed (String -> SrcLoc -> Id
C.Id String
t SrcLoc
forall a. IsLocation a => a
noLoc) [] SrcLoc
forall a. IsLocation a => a
noLoc) SrcLoc
forall a. IsLocation a => a
noLoc)
    (SrcLoc -> Decl
C.DeclRoot SrcLoc
forall a. IsLocation a => a
noLoc)
    SrcLoc
forall a. IsLocation a => a
noLoc

-- | Return the argument of a boolean negation expression
viewNotExp :: C.Exp -> Maybe C.Exp
viewNotExp :: Exp -> Maybe Exp
viewNotExp (C.UnOp UnOp
C.Lnot Exp
a SrcLoc
_)                     = Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
a
viewNotExp (C.FnCall (C.Var (C.Id String
"!" SrcLoc
_) SrcLoc
_) [Exp
a] SrcLoc
_) = Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
a
  -- Apparently this is what `!` parses to
viewNotExp Exp
_ = Maybe Exp
forall a. Maybe a
Nothing

arrayInit :: [C.Exp] -> C.Initializer
arrayInit :: [Exp] -> Initializer
arrayInit [Exp]
as = [(Maybe Designation, Initializer)] -> SrcLoc -> Initializer
C.CompoundInitializer
    [(Maybe Designation
forall a. Maybe a
Nothing, Exp -> SrcLoc -> Initializer
C.ExpInitializer Exp
a SrcLoc
forall a. IsLocation a => a
noLoc) | Exp
a <- [Exp]
as]
    SrcLoc
forall a. IsLocation a => a
noLoc



--------------------------------------------------------------------------------
-- * Code generation user interface
--------------------------------------------------------------------------------

-- | Compile a program to C code represented as a string. To compile the
-- resulting C code, use something like
--
-- > cc -std=c99 YOURPROGRAM.c
--
-- This function returns only the first (main) module. To get all C translation
-- unit, use 'compileAll'.
compile :: (Interp instr CGen (Param2 exp pred), HFunctor instr) =>
    Program instr (Param2 exp pred) a -> String
compile :: Program instr (Param2 exp pred) a -> String
compile = (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String)
-> (Program instr (Param2 exp pred) a -> (String, String))
-> Program instr (Param2 exp pred) a
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> (String, String)
forall a. [a] -> a
head ([(String, String)] -> (String, String))
-> (Program instr (Param2 exp pred) a -> [(String, String)])
-> Program instr (Param2 exp pred) a
-> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program instr (Param2 exp pred) a -> [(String, String)]
forall k k1 (instr :: (* -> *, (k, (k1, *))) -> * -> *) (exp :: k)
       (pred :: k1) a.
(Interp instr CGen (Param2 exp pred), HFunctor instr) =>
Program instr (Param2 exp pred) a -> [(String, String)]
compileAll

-- | Compile a program to C modules, each one represented as a pair of a name
-- and the code represented as a string. To compile the resulting C code, use
-- something like
--
-- > cc -std=c99 YOURPROGRAM.c
compileAll :: (Interp instr CGen (Param2 exp pred), HFunctor instr) =>
    Program instr (Param2 exp pred) a -> [(String, String)]
compileAll :: Program instr (Param2 exp pred) a -> [(String, String)]
compileAll
    = ((String, Doc) -> (String, String))
-> [(String, Doc)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"", Int -> Doc -> String
pretty Int
80) (String, Doc -> String) -> (String, Doc) -> (String, String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>) ([(String, Doc)] -> [(String, String)])
-> (Program instr (Param2 exp pred) a -> [(String, Doc)])
-> Program instr (Param2 exp pred) a
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CGen () -> [(String, Doc)]
forall a. CGen a -> [(String, Doc)]
prettyCGen (CGen () -> [(String, Doc)])
-> (Program instr (Param2 exp pred) a -> CGen ())
-> Program instr (Param2 exp pred) a
-> [(String, Doc)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CGen () -> CGen ()
forall (m :: * -> *) a. MonadC m => m a -> m ()
liftSharedLocals
    (CGen () -> CGen ())
-> (Program instr (Param2 exp pred) a -> CGen ())
-> Program instr (Param2 exp pred) a
-> CGen ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CGenT Identity a -> CGen ()
forall (m :: * -> *) a. MonadC m => m a -> m ()
wrapMain (CGenT Identity a -> CGen ())
-> (Program instr (Param2 exp pred) a -> CGenT Identity a)
-> Program instr (Param2 exp pred) a
-> CGen ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program instr (Param2 exp pred) a -> CGenT Identity a
forall k (i :: (* -> *, k) -> * -> *) (m :: * -> *) (fs :: k) a.
(Interp i m fs, HFunctor i, Monad m) =>
Program i fs a -> m a
interpret

-- | Compile a program to C code and print it on the screen. To compile the
-- resulting C code, use something like
--
-- > cc -std=c99 YOURPROGRAM.c
icompile :: (Interp instr CGen (Param2 exp pred), HFunctor instr) =>
    Program instr (Param2 exp pred) a -> IO ()
icompile :: Program instr (Param2 exp pred) a -> IO ()
icompile Program instr (Param2 exp pred) a
prog = case Program instr (Param2 exp pred) a -> [(String, String)]
forall k k1 (instr :: (* -> *, (k, (k1, *))) -> * -> *) (exp :: k)
       (pred :: k1) a.
(Interp instr CGen (Param2 exp pred), HFunctor instr) =>
Program instr (Param2 exp pred) a -> [(String, String)]
compileAll Program instr (Param2 exp pred) a
prog of
    [(String, String)
m] -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
m
    [(String, String)]
ms  -> ((String, String) -> IO ()) -> [(String, String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(String
n, String
m) -> String -> IO ()
putStrLn (String
"// module " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
m) [(String, String)]
ms

removeFileIfPossible :: FilePath -> IO ()
removeFileIfPossible :: String -> IO ()
removeFileIfPossible String
file =
    IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (String -> IO ()
removeFile String
file) (\(SomeException
_ :: SomeException) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

data ExternalCompilerOpts = ExternalCompilerOpts
      { ExternalCompilerOpts -> Bool
externalKeepFiles  :: Bool      -- ^ Keep generated files?
      , ExternalCompilerOpts -> [String]
externalFlagsPre   :: [String]  -- ^ External compiler flags (e.g. @["-Ipath"]@)
      , ExternalCompilerOpts -> [String]
externalFlagsPost  :: [String]  -- ^ External compiler flags after C source (e.g. @["-lm","-lpthread"]@)
      , ExternalCompilerOpts -> Bool
externalSilent     :: Bool      -- ^ Don't print anything besides what the program prints
      }

instance Default ExternalCompilerOpts
  where
    def :: ExternalCompilerOpts
def = ExternalCompilerOpts :: Bool -> [String] -> [String] -> Bool -> ExternalCompilerOpts
ExternalCompilerOpts
      { externalKeepFiles :: Bool
externalKeepFiles = Bool
False
      , externalFlagsPre :: [String]
externalFlagsPre  = []
      , externalFlagsPost :: [String]
externalFlagsPost = []
      , externalSilent :: Bool
externalSilent    = Bool
False
      }

maybePutStrLn :: Bool -> String -> IO ()
maybePutStrLn :: Bool -> String -> IO ()
maybePutStrLn Bool
False String
str = String -> IO ()
putStrLn String
str
maybePutStrLn Bool
_ String
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Generate C code and use CC to compile it
compileC :: (Interp instr CGen (Param2 exp pred), HFunctor instr)
    => ExternalCompilerOpts
    -> Program instr (Param2 exp pred) a  -- ^ Program to compile
    -> IO FilePath                        -- ^ Path to the generated executable
compileC :: ExternalCompilerOpts
-> Program instr (Param2 exp pred) a -> IO String
compileC (ExternalCompilerOpts {Bool
[String]
externalSilent :: Bool
externalFlagsPost :: [String]
externalFlagsPre :: [String]
externalKeepFiles :: Bool
externalSilent :: ExternalCompilerOpts -> Bool
externalFlagsPost :: ExternalCompilerOpts -> [String]
externalFlagsPre :: ExternalCompilerOpts -> [String]
externalKeepFiles :: ExternalCompilerOpts -> Bool
..}) Program instr (Param2 exp pred) a
prog = do
    String
tmp <- IO String
getTemporaryDirectory
    String
t   <- (UTCTime -> String) -> IO UTCTime -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
format) IO UTCTime
getCurrentTime
    (String
exeFile,Handle
exeh) <- String -> String -> IO (String, Handle)
openTempFile String
tmp (String
"edsl_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t)
    Handle -> IO ()
hClose Handle
exeh
    let cFile :: String
cFile = String
exeFile String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".c"
    String -> String -> IO ()
writeFile String
cFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Program instr (Param2 exp pred) a -> String
forall k k1 (instr :: (* -> *, (k, (k1, *))) -> * -> *) (exp :: k)
       (pred :: k1) a.
(Interp instr CGen (Param2 exp pred), HFunctor instr) =>
Program instr (Param2 exp pred) a -> String
compile Program instr (Param2 exp pred) a
prog
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
externalKeepFiles (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
maybePutStrLn Bool
externalSilent (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        String
"Created temporary file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cFile
    let compileCMD :: String
compileCMD = [String] -> String
unwords
          ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$  [String
"cc", String
"-std=c99"]
          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
externalFlagsPre
          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
cFile, String
"-o", String
exeFile]
          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
externalFlagsPost
    Bool -> String -> IO ()
maybePutStrLn Bool
externalSilent String
compileCMD
    ExitCode
exit <- String -> IO ExitCode
system String
compileCMD
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
externalKeepFiles (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeFileIfPossible String
cFile
    case ExitCode
exit of
      ExitCode
ExitSuccess -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
exeFile
      ExitCode
err -> do String -> IO ()
removeFileIfPossible String
exeFile
                String -> IO String
forall a. HasCallStack => String -> a
error String
"compileC: failed to compile generated C code"
  where
    format :: String
format = if Bool
externalKeepFiles then String
"%a-%H-%M-%S_" else String
""

-- | Generate C code and use CC to check that it compiles (no linking)
compileAndCheck' :: (Interp instr CGen (Param2 exp pred), HFunctor instr) =>
    ExternalCompilerOpts -> Program instr (Param2 exp pred) a -> IO ()
compileAndCheck' :: ExternalCompilerOpts -> Program instr (Param2 exp pred) a -> IO ()
compileAndCheck' ExternalCompilerOpts
opts Program instr (Param2 exp pred) a
prog = do
    let opts' :: ExternalCompilerOpts
opts' = ExternalCompilerOpts
opts {externalFlagsPre :: [String]
externalFlagsPre = String
"-c" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ExternalCompilerOpts -> [String]
externalFlagsPre ExternalCompilerOpts
opts}
    String
exe <- ExternalCompilerOpts
-> Program instr (Param2 exp pred) a -> IO String
forall k k1 (instr :: (* -> *, (k, (k1, *))) -> * -> *) (exp :: k)
       (pred :: k1) a.
(Interp instr CGen (Param2 exp pred), HFunctor instr) =>
ExternalCompilerOpts
-> Program instr (Param2 exp pred) a -> IO String
compileC ExternalCompilerOpts
opts' Program instr (Param2 exp pred) a
prog
    String -> IO ()
removeFileIfPossible String
exe

-- | Generate C code and use CC to check that it compiles (no linking)
compileAndCheck :: (Interp instr CGen (Param2 exp pred), HFunctor instr) =>
    Program instr (Param2 exp pred) a -> IO ()
compileAndCheck :: Program instr (Param2 exp pred) a -> IO ()
compileAndCheck = ExternalCompilerOpts -> Program instr (Param2 exp pred) a -> IO ()
forall k k1 (instr :: (* -> *, (k, (k1, *))) -> * -> *) (exp :: k)
       (pred :: k1) a.
(Interp instr CGen (Param2 exp pred), HFunctor instr) =>
ExternalCompilerOpts -> Program instr (Param2 exp pred) a -> IO ()
compileAndCheck' ExternalCompilerOpts
forall a. Default a => a
def

-- | Generate C code, use CC to compile it, and run the resulting executable
runCompiled' :: (Interp instr CGen (Param2 exp pred), HFunctor instr) =>
    ExternalCompilerOpts -> Program instr (Param2 exp pred) a -> IO ()
runCompiled' :: ExternalCompilerOpts -> Program instr (Param2 exp pred) a -> IO ()
runCompiled' opts :: ExternalCompilerOpts
opts@(ExternalCompilerOpts {Bool
[String]
externalSilent :: Bool
externalFlagsPost :: [String]
externalFlagsPre :: [String]
externalKeepFiles :: Bool
externalSilent :: ExternalCompilerOpts -> Bool
externalFlagsPost :: ExternalCompilerOpts -> [String]
externalFlagsPre :: ExternalCompilerOpts -> [String]
externalKeepFiles :: ExternalCompilerOpts -> Bool
..}) Program instr (Param2 exp pred) a
prog = IO String -> (String -> IO ()) -> (String -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (ExternalCompilerOpts
-> Program instr (Param2 exp pred) a -> IO String
forall k k1 (instr :: (* -> *, (k, (k1, *))) -> * -> *) (exp :: k)
       (pred :: k1) a.
(Interp instr CGen (Param2 exp pred), HFunctor instr) =>
ExternalCompilerOpts
-> Program instr (Param2 exp pred) a -> IO String
compileC ExternalCompilerOpts
opts Program instr (Param2 exp pred) a
prog)
    String -> IO ()
removeFileIfPossible
    ( \String
exe -> do
        Bool -> String -> IO ()
maybePutStrLn Bool
externalSilent String
""
        Bool -> String -> IO ()
maybePutStrLn Bool
externalSilent String
"#### Running:"
        String -> IO ExitCode
system String
exe IO ExitCode -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    )

-- | Generate C code, use CC to compile it, and run the resulting executable
runCompiled :: (Interp instr CGen (Param2 exp pred), HFunctor instr) =>
    Program instr (Param2 exp pred) a -> IO ()
runCompiled :: Program instr (Param2 exp pred) a -> IO ()
runCompiled = ExternalCompilerOpts -> Program instr (Param2 exp pred) a -> IO ()
forall k k1 (instr :: (* -> *, (k, (k1, *))) -> * -> *) (exp :: k)
       (pred :: k1) a.
(Interp instr CGen (Param2 exp pred), HFunctor instr) =>
ExternalCompilerOpts -> Program instr (Param2 exp pred) a -> IO ()
runCompiled' ExternalCompilerOpts
forall a. Default a => a
def

-- | Compile a program and make it available as an 'IO' function from 'String'
-- to 'String' (connected to @stdin@/@stdout@. respectively). Note that
-- compilation only happens once, even if the 'IO' function is used many times
-- in the body.
withCompiled' :: (Interp instr CGen (Param2 exp pred), HFunctor instr)
    => ExternalCompilerOpts
    -> Program instr (Param2 exp pred) a  -- ^ Program to compile
    -> ((String -> IO String) -> IO b)
         -- ^ Function that has access to the compiled executable as a function
    -> IO b
withCompiled' :: ExternalCompilerOpts
-> Program instr (Param2 exp pred) a
-> ((String -> IO String) -> IO b)
-> IO b
withCompiled' ExternalCompilerOpts
opts Program instr (Param2 exp pred) a
prog (String -> IO String) -> IO b
body = IO String -> (String -> IO ()) -> (String -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (ExternalCompilerOpts
-> Program instr (Param2 exp pred) a -> IO String
forall k k1 (instr :: (* -> *, (k, (k1, *))) -> * -> *) (exp :: k)
       (pred :: k1) a.
(Interp instr CGen (Param2 exp pred), HFunctor instr) =>
ExternalCompilerOpts
-> Program instr (Param2 exp pred) a -> IO String
compileC ExternalCompilerOpts
opts Program instr (Param2 exp pred) a
prog)
    String -> IO ()
removeFileIfPossible
    (\String
exe -> (String -> IO String) -> IO b
body ((String -> IO String) -> IO b) -> (String -> IO String) -> IO b
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String -> IO String
readProcess String
exe [])

-- | Compile a program and make it available as an 'IO' function from 'String'
-- to 'String' (connected to @stdin@/@stdout@. respectively). Note that
-- compilation only happens once, even if the 'IO' function is used many times
-- in the body.
withCompiled :: (Interp instr CGen (Param2 exp pred), HFunctor instr)
    => Program instr (Param2 exp pred) a  -- ^ Program to compile
    -> ((String -> IO String) -> IO b)
         -- ^ Function that has access to the compiled executable as a function
    -> IO b
withCompiled :: Program instr (Param2 exp pred) a
-> ((String -> IO String) -> IO b) -> IO b
withCompiled = ExternalCompilerOpts
-> Program instr (Param2 exp pred) a
-> ((String -> IO String) -> IO b)
-> IO b
forall k k1 (instr :: (* -> *, (k, (k1, *))) -> * -> *) (exp :: k)
       (pred :: k1) a b.
(Interp instr CGen (Param2 exp pred), HFunctor instr) =>
ExternalCompilerOpts
-> Program instr (Param2 exp pred) a
-> ((String -> IO String) -> IO b)
-> IO b
withCompiled' ExternalCompilerOpts
forall a. Default a => a
def {externalSilent :: Bool
externalSilent = Bool
True}

-- | Like 'runCompiled'' but with explicit input/output connected to
-- @stdin@/@stdout@. Note that the program will be compiled every time the
-- function is applied to a string. In order to compile once and run many times,
-- use the function 'withCompiled''.
captureCompiled' :: (Interp instr CGen (Param2 exp pred), HFunctor instr)
    => ExternalCompilerOpts
    -> Program instr (Param2 exp pred) a  -- ^ Program to run
    -> String                             -- ^ Input to send to @stdin@
    -> IO String                          -- ^ Result from @stdout@
captureCompiled' :: ExternalCompilerOpts
-> Program instr (Param2 exp pred) a -> String -> IO String
captureCompiled' ExternalCompilerOpts
opts Program instr (Param2 exp pred) a
prog String
inp = ExternalCompilerOpts
-> Program instr (Param2 exp pred) a
-> ((String -> IO String) -> IO String)
-> IO String
forall k k1 (instr :: (* -> *, (k, (k1, *))) -> * -> *) (exp :: k)
       (pred :: k1) a b.
(Interp instr CGen (Param2 exp pred), HFunctor instr) =>
ExternalCompilerOpts
-> Program instr (Param2 exp pred) a
-> ((String -> IO String) -> IO b)
-> IO b
withCompiled' ExternalCompilerOpts
opts Program instr (Param2 exp pred) a
prog ((String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
inp)

-- | Like 'runCompiled' but with explicit input/output connected to
-- @stdin@/@stdout@. Note that the program will be compiled every time the
-- function is applied to a string. In order to compile once and run many times,
-- use the function 'withCompiled'.
captureCompiled :: (Interp instr CGen (Param2 exp pred), HFunctor instr)
    => Program instr (Param2 exp pred) a  -- ^ Program to run
    -> String                             -- ^ Input to send to @stdin@
    -> IO String                          -- ^ Result from @stdout@
captureCompiled :: Program instr (Param2 exp pred) a -> String -> IO String
captureCompiled = ExternalCompilerOpts
-> Program instr (Param2 exp pred) a -> String -> IO String
forall k k1 (instr :: (* -> *, (k, (k1, *))) -> * -> *) (exp :: k)
       (pred :: k1) a.
(Interp instr CGen (Param2 exp pred), HFunctor instr) =>
ExternalCompilerOpts
-> Program instr (Param2 exp pred) a -> String -> IO String
captureCompiled' ExternalCompilerOpts
forall a. Default a => a
def

-- | Compare the content written to @stdout@ from the reference program and from
-- running the compiled C code
compareCompiled' :: (Interp instr CGen (Param2 exp pred), HFunctor instr)
    => ExternalCompilerOpts
    -> Program instr (Param2 exp pred) a  -- ^ Program to run
    -> IO a                               -- ^ Reference program
    -> String                             -- ^ Input to send to @stdin@
    -> IO ()
compareCompiled' :: ExternalCompilerOpts
-> Program instr (Param2 exp pred) a -> IO a -> String -> IO ()
compareCompiled' opts :: ExternalCompilerOpts
opts@(ExternalCompilerOpts {Bool
[String]
externalSilent :: Bool
externalFlagsPost :: [String]
externalFlagsPre :: [String]
externalKeepFiles :: Bool
externalSilent :: ExternalCompilerOpts -> Bool
externalFlagsPost :: ExternalCompilerOpts -> [String]
externalFlagsPre :: ExternalCompilerOpts -> [String]
externalKeepFiles :: ExternalCompilerOpts -> Bool
..}) Program instr (Param2 exp pred) a
prog IO a
ref String
inp = do
    Bool -> String -> IO ()
maybePutStrLn Bool
externalSilent String
"#### Reference program:"
    String
outRef <- IO a -> String -> IO String
forall a. IO a -> String -> IO String
fakeIO IO a
ref String
inp
    Bool -> String -> IO ()
maybePutStrLn Bool
externalSilent String
outRef
    Bool -> String -> IO ()
maybePutStrLn Bool
externalSilent String
"#### runCompiled:"
    String
outComp <- ExternalCompilerOpts
-> Program instr (Param2 exp pred) a -> String -> IO String
forall k k1 (instr :: (* -> *, (k, (k1, *))) -> * -> *) (exp :: k)
       (pred :: k1) a.
(Interp instr CGen (Param2 exp pred), HFunctor instr) =>
ExternalCompilerOpts
-> Program instr (Param2 exp pred) a -> String -> IO String
captureCompiled' ExternalCompilerOpts
opts Program instr (Param2 exp pred) a
prog String
inp
    Bool -> String -> IO ()
maybePutStrLn Bool
externalSilent String
outComp
    if String
outRef String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
outComp
      then String -> IO ()
forall a. HasCallStack => String -> a
error String
"runCompiled differs from reference program"
      else Bool -> String -> IO ()
maybePutStrLn Bool
externalSilent
             String
"  -- runCompiled is consistent with reference program\n\n\n\n"

-- | Compare the content written to @stdout@ from the reference program and from
-- running the compiled C code
compareCompiled :: (Interp instr CGen (Param2 exp pred), HFunctor instr)
    => Program instr (Param2 exp pred) a  -- ^ Program to run
    -> IO a                               -- ^ Reference program
    -> String                             -- ^ Input to send to @stdin@
    -> IO ()
compareCompiled :: Program instr (Param2 exp pred) a -> IO a -> String -> IO ()
compareCompiled = ExternalCompilerOpts
-> Program instr (Param2 exp pred) a -> IO a -> String -> IO ()
forall k k1 (instr :: (* -> *, (k, (k1, *))) -> * -> *) (exp :: k)
       (pred :: k1) a.
(Interp instr CGen (Param2 exp pred), HFunctor instr) =>
ExternalCompilerOpts
-> Program instr (Param2 exp pred) a -> IO a -> String -> IO ()
compareCompiled' ExternalCompilerOpts
forall a. Default a => a
def