~jojo/Carth

b357627c90810c29b93cd9823eb9831051b30eaa — JoJo 1 year, 7 months ago e0ddea2
Add `--verbose` flag. Don't print stuff when off.
4 files changed, 67 insertions(+), 36 deletions(-)

M app/GetConfig.hs
M app/Main.hs
M src/Compile.hs
M src/Conf.hs
M app/GetConfig.hs => app/GetConfig.hs +6 -2
@@ 70,6 70,7 @@ compileCfg args = do
            , cOutfile = outf
            , cCompiler = "cc"
            , cDebug = False
            , cVerbose = False
            }
        cfg = foldl (&) defaultCfg fs
    pure (CompileConf cfg)


@@ 77,7 78,7 @@ compileCfg args = do
runCfg :: [String] -> IO Conf
runCfg args = do
    (fs, inf) <- get args runOpts usageRun
    let defaultCfg = RunConfig { rInfile = inf, rDebug = False }
    let defaultCfg = RunConfig { rInfile = inf, rDebug = False, rVerbose = False }
        cfg = foldl (&) defaultCfg fs
    pure (RunConf cfg)



@@ 130,11 131,14 @@ compileOpts =
        (ReqArg (\f c -> c { cOutfile = f }) "FILE")
        "Output filepath"
    , Option [] ["debug"] (NoArg (\c -> c { cDebug = True })) "Enable debugging"
    , Option ['v'] ["verbose"] (NoArg (\c -> c { cVerbose = True })) "Verbose output"
    ]

runOpts :: [OptDescr (RunConfig -> RunConfig)]
runOpts =
    [Option [] ["debug"] (NoArg (\c -> c { rDebug = True })) "Enable debugging"]
    [ Option [] ["debug"] (NoArg (\c -> c { rDebug = True })) "Enable debugging"
    , Option ['v'] ["verbose"] (NoArg (\c -> c { rVerbose = True })) "Verbose output"
    ]

printVersion :: IO ()
printVersion = do

M app/Main.hs => app/Main.hs +13 -12
@@ 28,12 28,12 @@ compileFile :: CompileConfig -> IO ()
compileFile cfg = do
    let f = cInfile cfg
    putStrLn ("   Compiling " ++ f ++ "")
    putStrLn ("     Environment variables:")
    verbose cfg ("     Environment variables:")
    lp <- lookupEnv "LIBRARY_PATH"
    mp <- modulePaths
    putStrLn ("       library path = " ++ show lp)
    putStrLn ("       module paths = " ++ show mp)
    mon <- frontend (cDebug cfg) f
    verbose cfg ("       library path = " ++ show lp)
    verbose cfg ("       module paths = " ++ show mp)
    mon <- frontend cfg f
    compile f cfg mon
    putStrLn ""



@@ 41,22 41,23 @@ runFile :: RunConfig -> IO ()
runFile cfg = do
    let f = rInfile cfg
    putStrLn ("   Running " ++ f ++ "")
    putStrLn ("     Environment variables:")
    verbose cfg ("     Environment variables:")
    mp <- modulePaths
    putStrLn ("       module paths = " ++ show mp)
    mon <- frontend (rDebug cfg) f
    verbose cfg ("       module paths = " ++ show mp)
    mon <- frontend cfg f
    run f cfg mon
    putStrLn ""

frontend :: Bool -> FilePath -> IO Monomorphic.Program
frontend d f = do
    putStrLn ("   Parsing")
frontend :: Config cfg => cfg -> FilePath -> IO Monomorphic.Program
frontend cfg f = do
    let d = getDebug cfg
    verbose cfg ("   Parsing")
    ast <- parse f
    when d $ writeFile ".dbg.parsed" (pretty ast)
    putStrLn ("   Typechecking")
    verbose cfg ("   Typechecking")
    ann <- typecheck' f ast
    when d $ writeFile ".dbg.checked" (show ann)
    putStrLn ("   Monomorphizing")
    verbose cfg ("   Monomorphizing")
    let mon = monomorphize ann
    when d $ writeFile ".dbg.mono" (show mon)
    pure mon

M src/Compile.hs => src/Compile.hs +19 -19
@@ 32,19 32,19 @@ import Codegen


compile :: FilePath -> CompileConfig -> Monomorphic.Program -> IO ()
compile = handleProgram compileModule cDebug
compile = handleProgram compileModule

run :: FilePath -> RunConfig -> Monomorphic.Program -> IO ()
run = handleProgram (const orcJitModule) rDebug
run = handleProgram orcJitModule

handleProgram
    :: (config -> TargetMachine -> Module -> IO ())
    -> (config -> Bool)
    :: Config cfg
    => (cfg -> TargetMachine -> Module -> IO ())
    -> FilePath
    -> config
    -> cfg
    -> Monomorphic.Program
    -> IO ()
handleProgram f debug file cfg pgm = withContext $ \ctx ->
handleProgram f file cfg pgm = withContext $ \ctx ->
    -- When `--debug` is given, only -O1 optimize the code. Otherwise, optimize
    -- by -O2. No point in going further to -O3, as those optimizations are
    -- expensive and seldom actually improve the performance in a statistically


@@ 53,20 53,20 @@ handleProgram f debug file cfg pgm = withContext $ \ctx ->
    -- A minimum optimization level of -O1 ensures that all sibling calls are
    -- optimized, even if we don't use a calling convention like `fastcc` that
    -- can optimize any tail call.
    let optLvl = if debug cfg then CodeGenOpt.Less else CodeGenOpt.Default
    let optLvl = if (getDebug cfg) then CodeGenOpt.Less else CodeGenOpt.Default
    in
        withHostTargetMachinePIC optLvl $ \tm -> do
            layout <- getTargetMachineDataLayout tm
            putStrLn ("   Generating LLVM")
            verbose cfg ("   Generating LLVM")
            let amod = codegen layout file pgm
            withModuleFromAST ctx amod $ \mod -> do
                putStrLn ("   Verifying LLVM")
                when (debug cfg) $ writeLLVMAssemblyToFile' ".dbg.ll" mod
                verbose cfg ("   Verifying LLVM")
                when (getDebug cfg) $ writeLLVMAssemblyToFile' ".dbg.ll" mod
                verify mod
                withPassManager (optPasses optLvl tm) $ \passman -> do
                    putStrLn "   Optimizing"
                    verbose cfg "   Optimizing"
                    _ <- runPassManager passman mod
                    when (debug cfg)
                    when (getDebug cfg)
                        $ writeLLVMAssemblyToFile' ".dbg.opt.ll" mod
                    f cfg tm mod



@@ 74,9 74,9 @@ compileModule :: CompileConfig -> TargetMachine -> Module -> IO ()
compileModule cfg tm mod = do
    let exefile = cOutfile cfg
        ofile = replaceExtension exefile "o"
    putStrLn "   Writing object"
    verbose cfg "   Writing object"
    writeObjectToFile tm (File ofile) mod
    putStrLn ("   Linking")
    verbose cfg ("   Linking")
    callProcess
        (cCompiler cfg)
        [ "-o"


@@ 91,14 91,14 @@ compileModule cfg tm mod = do
foreign import ccall "dynamic"
  mkMain :: FunPtr (IO Int32) -> IO Int32

orcJitModule :: TargetMachine -> Module -> IO ()
orcJitModule tm mod = do
    putStrLn "   Running with OrcJIT"
orcJitModule :: RunConfig -> TargetMachine -> Module -> IO ()
orcJitModule cfg tm mod = do
    verbose cfg "   Running with OrcJIT"
    let libs = ["libsigsegv.so", "libcarth_foreign_core.so"]
    forM_ libs $ \lib -> do
        putStrLn $ "   Loading symbols of " ++ lib
        verbose cfg $ "   Loading symbols of " ++ lib
        r <- loadLibraryPermanently (Just lib)
        when r (putStrLn ("   Error loading " ++ lib))
        when r (putStrLn ("   Error loading " ++ lib) *> exitFailure)
    resolvers <- newIORef Map.empty
    let linkingResolver key = fmap (Map.! key) (readIORef resolvers)
    session <- createExecutionSession

M src/Conf.hs => src/Conf.hs +29 -3
@@ 1,4 1,13 @@
module Conf (Conf(..), CompileConfig(..), RunConfig(..)) where
module Conf
    ( Conf(..)
    , CompileConfig(..)
    , RunConfig(..)
    , verbose
    , Config(..)
    )
where

import Control.Monad

data Conf
    = CompileConf CompileConfig


@@ 9,8 18,25 @@ data CompileConfig = CompileConfig
    , cOutfile :: FilePath
    -- | Path to C compiler to use for linking and compiling ".c" files
    , cCompiler :: FilePath
    , cDebug :: Bool }
    , cDebug :: Bool
    , cVerbose :: Bool
    }

data RunConfig = RunConfig
    { rInfile :: FilePath
    , rDebug :: Bool }
    , rDebug :: Bool
    , rVerbose :: Bool
    }

class Config cfg where
    getDebug :: cfg -> Bool
    getVerbose :: cfg -> Bool
instance Config CompileConfig where
    getDebug = cDebug
    getVerbose = cVerbose
instance Config RunConfig where
    getDebug = rDebug
    getVerbose = rVerbose

verbose :: Config cfg => cfg -> String -> IO ()
verbose cfg msg = when (getVerbose cfg) $ putStrLn msg