Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 8 additions & 6 deletions src/AST.hs
Original file line number Diff line number Diff line change
Expand Up @@ -483,18 +483,19 @@ 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
-- compiler state over the IO monad.
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.
Expand Down Expand Up @@ -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.
Expand Down
7 changes: 4 additions & 3 deletions src/ASTShow.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
10 changes: 6 additions & 4 deletions src/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -180,19 +180,21 @@ 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


-- | Command and switches to compile a .ll file to an object file.
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


Expand Down
15 changes: 13 additions & 2 deletions src/Options.hs
Original file line number Diff line number Diff line change
Expand Up @@ -41,10 +41,13 @@ 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
-- ^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
Expand All @@ -66,7 +69,9 @@ defaultOptions = Options
, optHelpOpt = False
, optLibDirs = []
, optLogAspects = Set.empty
, optLogFile = Nothing
, optOptimisations = defaultOptFlags
, optLlcBin = "llc"
, optLLVMOptLevel = 3
, optDumpLib = False
, optVerbose = False
Expand Down Expand Up @@ -222,8 +227,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"
Expand All @@ -239,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"
Expand Down
22 changes: 13 additions & 9 deletions src/wybemk.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading