From 8d7e75174a4a281ef78b3c8f4a5ee86da13efaf3 Mon Sep 17 00:00:00 2001 From: James Barnes Date: Sun, 20 Apr 2025 16:10:43 +1000 Subject: [PATCH 1/2] Add --log-file flag (#478) --- src/AST.hs | 14 ++++++++------ src/ASTShow.hs | 7 ++++--- src/Options.hs | 10 ++++++++-- src/wybemk.hs | 22 +++++++++++++--------- 4 files changed, 33 insertions(+), 20 deletions(-) diff --git a/src/AST.hs b/src/AST.hs index 3c71650f..0e92e891 100644 --- a/src/AST.hs +++ b/src/AST.hs @@ -483,8 +483,9 @@ data CompilerState = Compiler { errorState :: Bool, -- ^whether or not we've seen any errors modules :: Map ModSpec Module, -- ^all known modules except what we're loading underCompilation :: [Module], -- ^the modules in the process of being compiled - unchangedMods :: Set ModSpec -- ^record mods that are loaded from object + unchangedMods :: Set ModSpec, -- ^record mods that are loaded from object -- and unchanged. + logHandle :: Handle -- ^handle to write logs to } -- |The compiler monad is a state transformer monad carrying the @@ -492,9 +493,9 @@ data CompilerState = Compiler { type Compiler = StateT CompilerState IO -- |Run a compiler function from outside the Compiler monad. -runCompiler :: Options -> Compiler t -> IO t -runCompiler opts comp = evalStateT comp - (Compiler opts "" [] False Map.empty [] Set.empty) +runCompiler :: Options -> Handle -> Compiler t -> IO t +runCompiler opts logHandle comp = evalStateT comp + (Compiler opts "" [] False Map.empty [] Set.empty logHandle) -- |Apply some transformation function to the compiler state. @@ -4476,8 +4477,9 @@ logMsg :: LogSelection -- ^ The aspect of the compiler being logged, -> Compiler () -- ^ Works in the Compiler monad logMsg selector msg = do prefix <- makeBold $ show selector ++ ": " - whenLogging selector $ - liftIO $ hPutStrLn stderr (prefix ++ List.intercalate ('\n':prefix) (lines msg)) + whenLogging selector $ do + logFile <- gets logHandle + liftIO $ hPutStrLn logFile (prefix ++ List.intercalate ('\n':prefix) (lines msg)) -- | Appends a ISO/IEC 6429 code to the given string to print it bold -- in a terminal output. diff --git a/src/ASTShow.hs b/src/ASTShow.hs index 868a82d7..ad4c1955 100644 --- a/src/ASTShow.hs +++ b/src/ASTShow.hs @@ -94,14 +94,15 @@ logDumpWith :: (Handle -> ModSpec -> Bool -> Bool -> Compiler ()) -> LogSelection -> LogSelection -> String -> Compiler () logDumpWith llPrinter selector1 selector2 pass = whenLogging2 selector1 selector2 $ do + logFile <- gets logHandle modList <- gets (Map.elems . modules) dumpLib <- gets (optDumpLib . options) let toLog mod = let spec = modSpec mod in List.null spec || dumpLib || head spec /= "wybe" let logging = List.filter toLog modList - liftIO $ hPutStrLn stderr $ replicate 70 '=' + liftIO $ hPutStrLn logFile $ replicate 70 '=' ++ "\nAFTER " ++ pass ++ ":\n" forM_ logging $ \mod -> do - liftIO $ hPutStrLn stderr $ "\n" ++ replicate 50 '-' ++ "\n" + liftIO $ hPutStrLn logFile $ "\n" ++ replicate 50 '-' ++ "\n" ++ show mod ++ "\n\n LLVM code :\n" - llPrinter stderr (modSpec mod) False False + llPrinter logFile (modSpec mod) False False diff --git a/src/Options.hs b/src/Options.hs index afc736ae..26e2b239 100644 --- a/src/Options.hs +++ b/src/Options.hs @@ -41,6 +41,8 @@ data Options = Options , optHelpLog :: Bool -- ^Print log option help and exit , optHelpOpt :: Bool -- ^Print optiisation option help and exit , optLibDirs :: [String] -- ^Directories where library files live + , optLogFile :: Maybe String + -- ^Path where to dump logs , optLogAspects :: Set LogSelection -- ^Which aspects to log , optOptimisations :: Set OptFlag @@ -66,6 +68,7 @@ defaultOptions = Options , optHelpOpt = False , optLibDirs = [] , optLogAspects = Set.empty + , optLogFile = Nothing , optOptimisations = defaultOptFlags , optLLVMOptLevel = 3 , optDumpLib = False @@ -222,8 +225,11 @@ options = (ReqArg (\ d opts -> opts { optLibDirs = optLibDirs opts ++ [d] }) "DIR") ("specify a library directory [default $WYBELIBS or " ++ libDir ++ "]") , Option ['l'] ["log"] - (ReqArg addLogAspects "ASPECT") - "add comma-separated aspects to log, or 'all'" + (ReqArg addLogAspects "ASPECT") + "add comma-separated aspects to log, or 'all'" + , Option [] ["log-file"] + (ReqArg (\ f opts -> opts { optLogFile = Just f }) "FILE") + "File to write logs to" , Option ['h'] ["help"] (NoArg (\ opts -> opts { optShowHelp = True })) "display this help text and exit" diff --git a/src/wybemk.hs b/src/wybemk.hs index 4a978d11..d2d54081 100644 --- a/src/wybemk.hs +++ b/src/wybemk.hs @@ -17,22 +17,26 @@ import AST import Builder import Control.Exception import Control.Monad +import Data.Maybe import Options import System.Exit +import System.IO -- |The main wybe compiler command line. main :: IO () main = do (opts, files) <- handleCmdline - catchAny - (runCompiler opts (buildTargets files)) - -- if there's an exception, print to stdout - -- XXX should probably go to stderr; but for now logging goes there - (\e -> do - let msg = show e - when (msg /= "ExitFailure 1") $ - putStrLn $ displayException e - exitFailure) + let logger = fromMaybe ($ stderr) $ (`withFile` WriteMode) <$> optLogFile opts + logger $ \logHandle -> + catchAny + (runCompiler opts logHandle (buildTargets files)) + -- if there's an exception, print to stdout + -- XXX should probably go to stderr; but for now logging defaults to there + (\e -> do + let msg = show e + when (msg /= "ExitFailure 1") $ + putStrLn $ displayException e + exitFailure) catchAny :: IO a -> (SomeException -> IO a) -> IO a From 1d77fdefa447cc1447d0459034f684a924aa0b68 Mon Sep 17 00:00:00 2001 From: James Barnes Date: Sun, 20 Apr 2025 16:20:10 +1000 Subject: [PATCH 2/2] Add --llc-path flag (#477) --- src/Config.hs | 10 ++++++---- src/Options.hs | 5 +++++ 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/src/Config.hs b/src/Config.hs index e6a5a9f7..13510f5a 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -180,9 +180,10 @@ llvmToNativeAssemblerCommand :: FilePath -> FilePath -> Options -> (String, [String]) llvmToNativeAssemblerCommand llFile sFile options = let opt = "-O" ++ show (optLLVMOptLevel options) + llc = optLlcBin options in case buildOS of - OSX -> ("llc", ["--filetype=asm", opt, "-o", sFile, llFile]) - Linux -> ("llc", ["--filetype=asm", opt, "-o", sFile, llFile]) + OSX -> (llc, ["--filetype=asm", opt, "-o", sFile, llFile]) + Linux -> (llc, ["--filetype=asm", opt, "-o", sFile, llFile]) os -> error $ "Unsupported OS: " ++ show os @@ -190,9 +191,10 @@ llvmToNativeAssemblerCommand llFile sFile options = llvmToObjectCommand :: FilePath -> FilePath -> Options -> (String, [String]) llvmToObjectCommand llFile oFile options = let opt = "-O" ++ show (optLLVMOptLevel options) + llc = optLlcBin options in case buildOS of - OSX -> ("llc", ["--filetype=obj", opt, "-o", oFile, llFile]) - Linux -> ("llc", ["--filetype=obj", opt, "-o", oFile, llFile]) + OSX -> (llc, ["--filetype=obj", opt, "-o", oFile, llFile]) + Linux -> (llc, ["--filetype=obj", opt, "-o", oFile, llFile]) os -> error $ "Unsupported OS: " ++ show os diff --git a/src/Options.hs b/src/Options.hs index 26e2b239..75a224d7 100644 --- a/src/Options.hs +++ b/src/Options.hs @@ -47,6 +47,7 @@ data Options = Options -- ^Which aspects to log , optOptimisations :: Set OptFlag -- ^Enabled optimisations + , optLlcBin :: String -- ^LLVM 'llc' binary path , optLLVMOptLevel :: Word -- ^LLVM optimisation level , optDumpLib :: Bool -- ^Also dump wybe.* modules when dumping , optVerbose :: Bool -- ^Be verbose in compiler output @@ -70,6 +71,7 @@ defaultOptions = Options , optLogAspects = Set.empty , optLogFile = Nothing , optOptimisations = defaultOptFlags + , optLlcBin = "llc" , optLLVMOptLevel = 3 , optDumpLib = False , optVerbose = False @@ -245,6 +247,9 @@ options = , Option ['x'] ["opt"] (ReqArg addOptFlags "FLAGS") "add comma-separated optimisation flags" + , Option [] ["llc-path"] + (ReqArg (\ llc opts -> opts { optLlcBin = llc }) "PATH") + "specify the path of the 'llc' used" , Option ['O'] ["llvm-opt-level"] (ReqArg setLLVMOptLevel "LEVEL") "specify the LLVM compiler optimisation level"