summaryrefslogtreecommitdiff
path: root/tool
diff options
context:
space:
mode:
authorCsaba Hruska <csaba.hruska@gmail.com>2018-09-22 12:39:00 +0200
committerCsaba Hruska <csaba.hruska@gmail.com>2018-09-22 12:39:00 +0200
commitef09f1441cf2b84b7c961bb4b28cd81d807a0843 (patch)
tree1fbde01c7278c559aa89cee3ef987c2af8ed94b2 /tool
parent3acea61ec05c54671e6e2b1254b35130a8b502c8 (diff)
add core dump option to cli
Diffstat (limited to 'tool')
-rw-r--r--tool/Compiler.hs16
1 files changed, 15 insertions, 1 deletions
diff --git a/tool/Compiler.hs b/tool/Compiler.hs
index c8706b1b..2681795c 100644
--- a/tool/Compiler.hs
+++ b/tool/Compiler.hs
@@ -1,6 +1,7 @@
1import Data.Monoid 1import Data.Monoid
2import Control.Monad 2import Control.Monad
3import Options.Applicative 3import Options.Applicative
4import Data.Either
4import Data.Aeson 5import Data.Aeson
5import qualified Data.ByteString.Lazy as B 6import qualified Data.ByteString.Lazy as B
6import System.FilePath 7import System.FilePath
@@ -20,10 +21,17 @@ main = join $ execParser $ addInfo i $ versionOption <*> subparser (
20 <*> pure ["."] 21 <*> pure ["."]
21 <*> optional (strOption (long "output" <> short 'o' <> metavar "FILENAME" <> help "output file name")) 22 <*> optional (strOption (long "output" <> short 'o' <> metavar "FILENAME" <> help "output file name"))
22 ) 23 )
24 <> command "dump" (addInfo (progDesc "dumps LambdaCube3D core") $ dump
25 <$> argument str (metavar "SOURCE_FILE")
26 <*> flag OpenGL33 WebGL1 (long "webgl" <> help "generate WebGL 1.0 pipeline" )
27 <*> pure ["."]
28 <*> optional (strOption (long "output" <> short 'o' <> metavar "FILENAME" <> help "output file name"))
29 )
23 <> command "pretty" (addInfo (progDesc "pretty prints JSON IR") $ prettyPrint 30 <> command "pretty" (addInfo (progDesc "pretty prints JSON IR") $ prettyPrint
24 <$> argument str (metavar "SOURCE_FILE") 31 <$> argument str (metavar "SOURCE_FILE")
25 <*> optional (strOption (long "output" <> short 'o' <> metavar "FILENAME" <> help "output file name")) 32 <*> optional (strOption (long "output" <> short 'o' <> metavar "FILENAME" <> help "output file name"))
26 )) <|> compile' 33 )
34 ) <|> compile'
27 where 35 where
28 compile' = (compile 36 compile' = (compile
29 <$> argument str (metavar "SOURCE_FILE") 37 <$> argument str (metavar "SOURCE_FILE")
@@ -60,6 +68,12 @@ parse srcName backend includePaths output = do
60 Left err -> fail $ show err 68 Left err -> fail $ show err
61 Right ppl -> maybe (putStrLn ppl) (`writeFile` ppl) output 69 Right ppl -> maybe (putStrLn ppl) (`writeFile` ppl) output
62 70
71dump srcName backend includePaths output = do
72 res <- runMM (ioFetch includePaths) $ getDef srcName "main" (Just outputType)
73 let Right e = snd $ fromRight (error "compile error: can not dump the core, try regular compile to get the error message") $ snd res
74 coreDump = show $ mkDoc (False,True) e
75 maybe (putStrLn coreDump) (`writeFile` coreDump) output
76
63compile srcName backend includePaths output = do 77compile srcName backend includePaths output = do
64 let ext = takeExtension srcName 78 let ext = takeExtension srcName
65 baseName | ext == ".lc" = dropExtension srcName 79 baseName | ext == ".lc" = dropExtension srcName