qux 0.1.0.0 → 0.2.0.0
raw patch · 9 files changed
+279/−160 lines, 9 filesdep +bytestringdep +containersdep +directorydep ~language-qux
Dependencies added: bytestring, containers, directory, filepath, llvm-general, pretty
Dependency ranges changed: language-qux
Files
- main/Main.hs +12/−17
- qux.cabal +15/−5
- src/Qux/Commands.hs +96/−61
- src/Qux/Commands/Build.hs +76/−15
- src/Qux/Commands/Check.hs +17/−6
- src/Qux/Commands/Compile.hs +33/−0
- src/Qux/Commands/Print.hs +13/−8
- src/Qux/Commands/Run.hs +0/−48
- src/Qux/Version.hs +17/−0
main/Main.hs view
@@ -1,6 +1,4 @@ -{-# OPTIONS_HADDOCK hide, prune #-}- {-| Module : Main @@ -9,30 +7,27 @@ Maintainer : public@hjwylde.com -} -module Main (- main-) where+{-# OPTIONS_HADDOCK hide, prune #-} -import Control.Applicative+module Main where import Options.Applicative-import Options.Applicative.Builder -import Qux.Commands-import qualified Qux.Commands.Build as Build-import qualified Qux.Commands.Check as Check-import qualified Qux.Commands.Print as Print-import qualified Qux.Commands.Run as Run+import Qux.Commands+import qualified Qux.Commands.Build as Build+import qualified Qux.Commands.Check as Check+import qualified Qux.Commands.Compile as Compile+import qualified Qux.Commands.Print as Print -- | Main. main :: IO ()-main = customExecParser (prefs $ columns 100) options >>= handle+main = customExecParser quxPrefs quxInfo >>= handle handle :: Options -> IO () handle options = case argCommand options of- Build options -> Build.handle options- Check options -> Check.handle options- Print options -> Print.handle options- Run options -> Run.handle options+ Build options -> Build.handle options+ Check options -> Check.handle options+ Compile options -> Compile.handle options+ Print options -> Print.handle options
qux.cabal view
@@ -1,12 +1,14 @@ name: qux-version: 0.1.0.0+version: 0.2.0.0 author: Henry J. Wylde maintainer: public@hjwylde.com homepage: https://github.com/qux-lang/qux synopsis: Command line binary for working with the Qux language--- description:+description: Qux is an experimental language developed from the ground up with the aim of static+ compile time verification. This package provides a binary for working with it+ (compiling, type checking and pretty printing). license: BSD3 license-file: LICENSE@@ -19,16 +21,24 @@ main-is: Main.hs hs-source-dirs: main/ src/ other-modules:+ Paths_qux, Qux.Commands, Qux.Commands.Build, Qux.Commands.Check,+ Qux.Commands.Compile, Qux.Commands.Print,- Qux.Commands.Run+ Qux.Version default-language: Haskell2010 build-depends: base >= 4.8 && < 5,- language-qux == 0.1.*,+ bytestring == 0.10.*,+ containers == 0.5.*,+ directory == 1.*,+ filepath == 1.*,+ language-qux == 0.2.*,+ llvm-general == 3.4.*, mtl == 2.*,- optparse-applicative == 0.11.*+ optparse-applicative == 0.11.*,+ pretty >= 1.1.2 && < 2
src/Qux/Commands.hs view
@@ -1,6 +1,4 @@ -{-# OPTIONS_HADDOCK hide, prune #-}- {-| Module : Qux.Commands @@ -9,54 +7,73 @@ Maintainer : public@hjwylde.com -} +{-# OPTIONS_HADDOCK hide, prune #-}+ module Qux.Commands where -import Language.Qux.Annotated.PrettyPrinter+import Data.Version (showVersion) +import qualified Language.Qux.Version as Qux+ import Options.Applicative import Options.Applicative.Types import Prelude hiding (print) -import qualified Qux.Commands.Build as Build-import qualified Qux.Commands.Check as Check-import qualified Qux.Commands.Print as Print-import qualified Qux.Commands.Run as Run+import qualified Qux.Commands.Build as Build+import qualified Qux.Commands.Check as Check+import qualified Qux.Commands.Compile as Compile+import qualified Qux.Commands.Print as Print+import qualified Qux.Version as Binary +import System.FilePath --- * Qux command+import Text.PrettyPrint (Mode(..)) -options :: ParserInfo Options-options = info (helper <*> version <*> qux) (fullDesc <> noIntersperse)++-- * Optparse for Qux++quxPrefs :: ParserPrefs+quxPrefs = prefs $ columns 100++quxInfo :: ParserInfo Options+quxInfo = info (infoOptions <*> qux) (fullDesc <> noIntersperse) where- version = infoOption "0.1.0" $ mconcat [- long "version",- short 'V',- help "Show this binary's version",- hidden+ infoOptions = helper <*> version <*> numericVersion <*> quxVersion+ version = infoOption ("Version " ++ showVersion Binary.version) $ mconcat [+ long "version", short 'V', hidden,+ help "Show this binary's version" ]+ numericVersion = infoOption (showVersion Binary.version) $ mconcat [+ long "numeric-version", hidden,+ help "Show this binary's version (without the prefix)"+ ]+ quxVersion = infoOption ("Qux version " ++ showVersion Qux.version) $ mconcat [+ long "qux-version", hidden,+ help "Show the qux version this binary was compiled with"+ ] +-- * Command+ data Options = Options { argCommand :: Command } --- TODO (hjw): show the help message if no commands given--- TODO (hjw): improve error message to say "Invalid command x" qux :: Parser Options qux = Options <$> subparser (mconcat [- command "build" $ info (helper <*> build) (fullDesc <> progDesc "Build FILE using composable options"),- command "check" $ info (helper <*> check) (fullDesc <> progDesc "Check FILE for correctness" <> header "Synonymous to `qux build --type-check'"),- command "print" $ info (helper <*> print) (fullDesc <> progDesc "Pretty print FILE"),- command "run" $ info (helper <*> run) (fullDesc <> progDesc "Run FILE passing in ARGS as program arguments")+ command "build" $ info (helper <*> build) (fullDesc <> progDesc "Build FILES using composable options"),+ command "check" $ info (helper <*> check) (fullDesc <> progDesc "Check FILES for correctness" <> header "Shortcut for `qux build --type-check'"),+ command "compile" $ info (helper <*> compile) (fullDesc <> progDesc "Compile FILES into the LLVM IR" <> header "Shortcut for `qux build --compile'"),+ command "print" $ info (helper <*> print) (fullDesc <> progDesc "Pretty print FILE") ]) -- * Subcommands -data Command = Build Build.Options- | Check Check.Options- | Print Print.Options- | Run Run.Options+data Command = Build Build.Options+ | Check Check.Options+ | Compile Compile.Options+ | Print Print.Options -- ** Build@@ -64,71 +81,89 @@ build :: Parser Command build = fmap Build $ Build.Options <$> switch (mconcat [+ long "compile", short 'c',+ help "Enable compilation to LLVM IR"+ ])+ <*> strOption (mconcat [+ long "destination", short 'd', metavar "DIR",+ value ("." ++ [pathSeparator]), showDefault,+ help "Specify the output directory to put the compiled LLVM IR"+ ])+ <*> formatOption (mconcat [+ long "format", short 'f', metavar "FORMAT",+ value Build.Bitcode, showDefault,+ help "Specify the LLVM output format as either `bitcode' or `assembly'"+ ])+ <*> switch (mconcat [ long "type-check", help "Enable type checking" ])- <*> strArgument (mconcat [- metavar "FILE"+ <*> some (strArgument $ mconcat [+ metavar "FILES..." ]) -- ** Check check :: Parser Command-check = Check . Check.Options <$> strArgument (mconcat [- metavar "FILE"+check = Check . Check.Options <$> some (strArgument $ mconcat [+ metavar "FILES..." ]) +-- ** Compile++compile :: Parser Command+compile = fmap Compile $ Compile.Options+ <$> strOption (mconcat [+ long "destination", short 'd', metavar "DIR",+ value ("." ++ [pathSeparator]), showDefault,+ help "Specify the output directory to put the compiled LLVM IR"+ ])+ <*> formatOption (mconcat [+ long "format", short 'f', metavar "FORMAT",+ value Build.Bitcode, showDefault,+ help "Specify the LLVM output format as either `bitcode' or `assembly'"+ ])+ <*> some (strArgument $ mconcat [+ metavar "FILES..."+ ])++ -- ** Print print :: Parser Command print = fmap Print $ Print.Options <$> option auto (mconcat [- long "line-length",- short 'l',- metavar "LENGTH",- value 100,- showDefault,+ long "line-length", short 'l', metavar "LENGTH",+ value 100, showDefault, help "Specify the maximum line length" ]) <*> modeOption (mconcat [- long "mode",- short 'm',- metavar "MODE",- value PageMode,- showDefaultWith $ const "normal",- help "Specify the rendering mode as either 'normal' or 'one-line'"+ long "mode", short 'm', metavar "MODE",+ value PageMode, showDefaultWith $ const "normal",+ help "Specify the rendering mode as either `normal' or `one-line'" ]) <*> option auto (mconcat [- long "ribbons-per-line",- short 'r',- metavar "RIBBONS",- value 1.5,- showDefault,+ long "ribbons-per-line", short 'r', metavar "RIBBONS",+ value 1.5, showDefault, help "Specify the ratio of line length to ribbon length" ]) <*> strArgument (mconcat [ metavar "FILE" ]) where- modeOption :: Mod OptionFields Mode -> Parser Mode- modeOption = option $ do- opt <- readerAsk+ modeOption = option $ readerAsk >>= \opt -> case opt of+ "normal" -> return PageMode+ "one-line" -> return OneLineMode+ _ -> readerError $ "unrecognised mode `" ++ opt ++ "'" - case opt of- "normal" -> return PageMode- "one-line" -> return OneLineMode- _ -> readerError $ "unrecognised mode `" ++ opt ++ "'" --- ** Run+-- ** Helpers -run :: Parser Command-run = fmap Run $ Run.Options- <$> strArgument (mconcat [- metavar "FILE"- ])- <*> many (strArgument $ mconcat [- metavar "ARGS..."- ])+formatOption :: Mod OptionFields Build.Format -> Parser Build.Format+formatOption = option $ readerAsk >>= \opt -> case opt of+ "assembly" -> return Build.Assembly+ "bitcode" -> return Build.Bitcode+ _ -> readerError $ "unrecognised format `" ++ opt ++ "'"
src/Qux/Commands/Build.hs view
@@ -1,6 +1,4 @@ -{-# OPTIONS_HADDOCK hide, prune #-}- {-| Module : Qux.Commands.Build @@ -9,39 +7,102 @@ Maintainer : public@hjwylde.com -} +{-# OPTIONS_HADDOCK hide, prune #-}+ module Qux.Commands.Build where import Control.Monad.Except+import Control.Monad.Identity -import Language.Qux.Annotated.Parser-import Language.Qux.Annotated.Syntax-import Language.Qux.Annotated.TypeChecker+import qualified Data.ByteString as BS+import Data.List (intercalate) +import Language.Qux.Annotated.Parser hiding (parse)+import qualified Language.Qux.Annotated.Parser as P+import Language.Qux.Annotated.Syntax+import Language.Qux.Annotated.TypeChecker+import Language.Qux.Annotated.TypeResolver+import qualified Language.Qux.Llvm.Compiler as C++import LLVM.General+import LLVM.General.Context++import System.Directory import System.Exit+import System.FilePath import System.IO+import System.IO.Error data Options = Options {+ optCompile :: Bool,+ optDestination :: FilePath,+ optFormat :: Format, optTypeCheck :: Bool,- argFilePath :: String+ argFilePaths :: [FilePath] } +defaultOptions :: Options+defaultOptions = Options {+ optCompile = False,+ optDestination = "." ++ [pathSeparator],+ optFormat = Bitcode,+ optTypeCheck = False,+ argFilePaths = []+ }++data Format = Assembly | Bitcode+ deriving Eq++instance Show Format where+ show Assembly = "assembly"+ show Bitcode = "bitcode"++ handle :: Options -> IO () handle options = do- let filePath = argFilePath options+ let filePaths = argFilePaths options+ fileContents <- mapM readFile filePaths - contents <- readFile $ argFilePath options+ ethr <- catchIOError+ (runExceptT $ zipWithM parse filePaths fileContents >>= mapM_ (build options))+ (return . Left . ioeGetErrorString) - case runExcept $ tryParse filePath contents >>= build options of+ case ethr of Left error -> hPutStrLn stderr error >> exitFailure Right _ -> return () -tryParse :: FilePath -> String -> Except String (Program SourcePos)-tryParse filePath contents = withExcept show (parse program filePath contents)+parse :: FilePath -> String -> ExceptT String IO (Program SourcePos)+parse filePath contents = resolve <$> mapExceptT (return . runIdentity) (withExcept show (P.parse program filePath contents)) -build :: Options -> Program SourcePos -> Except String ()-build options program = when (optTypeCheck options) (typeCheck program)+build :: Options -> Program SourcePos -> ExceptT String IO ()+build options program = do+ when (optTypeCheck options) $ typeCheck program+ when (optCompile options) $ compile options program -typeCheck :: Program SourcePos -> Except String ()-typeCheck program = withExcept show (check program)+typeCheck :: Program SourcePos -> ExceptT String IO ()+typeCheck program = when (not $ null errors) $ throwError (intercalate "\n\n" $ map show errors)+ where+ errors = check program++compile :: Options -> Program SourcePos -> ExceptT String IO ()+compile options program+ | optFormat options == Assembly = liftIO $ do+ assembly <- withContext $ \context ->+ runExceptT (withModuleFromAST context mod moduleLLVMAssembly) >>= either fail return++ createDirectoryIfMissing True basePath+ writeFile (addExtension (basePath ++ baseName) "ll") assembly+ | optFormat options == Bitcode = liftIO $ do+ bitcode <- withContext $ \context ->+ runExceptT (withModuleFromAST context mod moduleBitcode) >>= either fail return++ createDirectoryIfMissing True basePath+ BS.writeFile (addExtension (basePath ++ baseName) "bc") bitcode+ | otherwise = error $ "format not implemented `" ++ show (optFormat options) ++ "'"+ where+ module_ = let (Program _ module_ _) = program in map simp module_+ mod = C.compile $ simp program+ basePath = intercalate [pathSeparator] ([optDestination options] ++ init module_) ++ [pathSeparator]+ baseName = last module_
src/Qux/Commands/Check.hs view
@@ -1,6 +1,4 @@ -{-# OPTIONS_HADDOCK hide, prune #-}- {-| Module : Qux.Commands.Check @@ -9,18 +7,31 @@ Maintainer : public@hjwylde.com -} +{-# OPTIONS_HADDOCK hide, prune #-}+ module Qux.Commands.Check where +import Control.Monad.Except++import Language.Qux.Annotated.Parser+import Language.Qux.Annotated.Syntax+ import qualified Qux.Commands.Build as Build data Options = Options {- argFilePath :: String+ argFilePaths :: [FilePath] } handle :: Options -> IO ()-handle options = Build.handle Build.Options {- Build.argFilePath = argFilePath options,- Build.optTypeCheck = True+handle options = Build.handle $ buildOptions options++check :: Options -> Program SourcePos -> ExceptT String IO ()+check options = Build.build $ buildOptions options++buildOptions :: Options -> Build.Options+buildOptions options = Build.defaultOptions {+ Build.optTypeCheck = True,+ Build.argFilePaths = argFilePaths options }
+ src/Qux/Commands/Compile.hs view
@@ -0,0 +1,33 @@++{-|+Module : Qux.Commands.Compile++Copyright : (c) Henry J. Wylde, 2015+License : BSD3+Maintainer : public@hjwylde.com+-}++{-# OPTIONS_HADDOCK hide, prune #-}++module Qux.Commands.Compile where++import qualified Qux.Commands.Build as Build+++data Options = Options {+ optDestination :: FilePath,+ optFormat :: Build.Format,+ argFilePaths :: [FilePath]+ }++handle :: Options -> IO ()+handle options = Build.handle $ buildOptions options++buildOptions :: Options -> Build.Options+buildOptions options = Build.defaultOptions {+ Build.optCompile = True,+ Build.optDestination = optDestination options,+ Build.optFormat = optFormat options,+ Build.argFilePaths = argFilePaths options+ }+
src/Qux/Commands/Print.hs view
@@ -1,6 +1,4 @@ -{-# OPTIONS_HADDOCK hide, prune #-}- {-| Module : Qux.Commands.Print @@ -9,32 +7,39 @@ Maintainer : public@hjwylde.com -} +{-# OPTIONS_HADDOCK hide, prune #-}+ module Qux.Commands.Print where import Control.Monad.Except -import Language.Qux.Annotated.PrettyPrinter--import Qux.Commands.Build (tryParse)+import Qux.Commands.Build (parse) import System.Exit import System.IO+import System.IO.Error +import Text.PrettyPrint hiding (style)+import Text.PrettyPrint.HughesPJClass hiding (style) + data Options = Options { optLineLength :: Int, optMode :: Mode, optRibbonsPerLine :: Float,- argFilePath :: String+ argFilePath :: FilePath } handle :: Options -> IO () handle options = do let filePath = argFilePath options- contents <- readFile $ argFilePath options - case runExcept $ tryParse filePath contents of+ ethr <- catchIOError+ (runExceptT $ parse filePath contents)+ (return . Left . ioeGetErrorString)++ case ethr of Left error -> hPutStrLn stderr (show error) >> exitFailure Right program -> putStrLn $ renderStyle (style options) (pPrint program)
− src/Qux/Commands/Run.hs
@@ -1,48 +0,0 @@--{-# OPTIONS_HADDOCK hide, prune #-}--{-|-Module : Qux.Commands.Run--Copyright : (c) Henry J. Wylde, 2015-License : BSD3-Maintainer : public@hjwylde.com--}--module Qux.Commands.Run where--import Control.Monad.Except--import Language.Qux.Annotated.Simplify-import Language.Qux.Annotated.Syntax-import Language.Qux.Interpreter-import Language.Qux.PrettyPrinter--import Qux.Commands.Build (tryParse)--import System.Exit-import System.IO---data Options = Options {- argFilePath :: FilePath,- argsExtra :: [String]- }--handle :: Options -> IO ()-handle options = do- let filePath = argFilePath options-- contents <- readFile $ argFilePath options-- case runExcept $ tryParse filePath contents >>= run options of- Left error -> hPutStrLn stderr error >> exitFailure- Right result -> putStrLn result--run :: Options -> Program a -> Except String String-run options program = return $ render (pPrint result)- where- result = exec (sProgram program) main args- main = "main"- args = map (IntValue . read) (argsExtra options)-
+ src/Qux/Version.hs view
@@ -0,0 +1,17 @@++{-|+Module : Qux.Version++Copyright : (c) Henry J. Wylde, 2015+License : BSD3+Maintainer : public@hjwylde.com+-}++{-# OPTIONS_HADDOCK hide, prune #-}++module Qux.Version (+ version+) where++import Paths_qux (version)+