dbd7b244b7cbc8408a289bf48de825a32c2cd8a5
[barrelfish] / tools / sockeye / Main.hs
1 {-
2   SockeyeMain.hs: Sockeye
3
4   Copyright (c) 2017, ETH Zurich.
5
6   All rights reserved.
7
8   This file is distributed under the terms in the attached LICENSE file.
9   If you do not find this file, copies can be found by writing to:
10   ETH Zurich D-INFK, CAB F.78, Universitaetstr. 6, CH-8092 Zurich,
11   Attn: Systems Group.
12 -}
13
14 module Main where
15
16 import Control.Monad
17
18 import Data.List (intercalate)
19 import qualified Data.Map as Map
20
21 import System.Console.GetOpt
22 import System.Directory
23 import System.Exit
24 import System.Environment
25 import System.FilePath
26 import System.IO
27
28 import qualified SockeyeASTParser as ParseAST
29 import qualified SockeyeAST as AST
30 import qualified SockeyeASTInstantiator as InstAST
31 import qualified SockeyeASTDecodingNet as NetAST
32
33 import SockeyeParser
34 import SockeyeChecker
35 import SockeyeInstantiator
36 import SockeyeNetBuilder
37
38 import qualified SockeyeBackendProlog as Prolog
39
40 import Debug.Trace
41 import Text.Groom(groom)
42
43 {- Exit codes -}
44 usageError :: ExitCode
45 usageError = ExitFailure 1
46
47 fileError :: ExitCode
48 fileError = ExitFailure 2
49
50 parseError :: ExitCode
51 parseError = ExitFailure 3
52
53 checkError :: ExitCode
54 checkError = ExitFailure 4
55
56 buildError :: ExitCode
57 buildError = ExitFailure 5
58
59 {- Compilation targets -}
60 data Target = Prolog
61
62 {- Possible options for the Sockeye Compiler -}
63 data Options = Options
64     { optInputFile  :: FilePath
65     , optInclDirs   :: [FilePath]
66     , optTarget     :: Target
67     , optOutputFile :: FilePath
68     , optDepFile    :: Maybe FilePath
69     }
70
71 {- Default options -}
72 defaultOptions :: Options
73 defaultOptions = Options
74     { optInputFile  = ""
75     , optInclDirs   = [""]
76     , optTarget     = Prolog
77     , optOutputFile = ""
78     , optDepFile    = Nothing
79     }
80
81 {- Set the input file name -}
82 optSetInputFileName :: FilePath -> Options -> Options
83 optSetInputFileName f o = o { optInputFile = f }
84
85 optAddInclDir :: FilePath -> Options -> Options
86 optAddInclDir f o = o { optInclDirs = optInclDirs o ++ [f] }
87
88 {- Set the target -}
89 optSetTarget :: Target -> Options -> Options
90 optSetTarget t o = o { optTarget = t }
91
92 {- Set the output file name -}
93 optSetOutputFile :: FilePath -> Options -> Options
94 optSetOutputFile f o = o { optOutputFile = f }
95
96 {- Set the dependency file name -}
97 optSetDepFile :: FilePath -> Options -> Options
98 optSetDepFile f o = o { optDepFile = Just f }
99
100 {- Prints usage information possibly with usage errors -}
101 usage :: [String] -> IO ()
102 usage errors = do
103     prg <- getProgName
104     let usageString = "Usage: " ++ prg ++ " [options] file\nOptions:"
105     case errors of
106         [] -> return ()
107         _  -> hPutStrLn stderr $ concat errors
108     hPutStrLn stderr $ usageInfo usageString options
109     hPutStrLn stderr "The backend (capital letter options) specified last takes precedence."
110
111
112 {- Setup option parser -}
113 options :: [OptDescr (Options -> IO Options)]
114 options = 
115     [ Option "P" ["Prolog"]
116         (NoArg (\opts -> return $ optSetTarget Prolog opts))
117         "Generate a prolog file that can be loaded into the SKB (default)."
118     , Option "i" ["include"]
119         (ReqArg (\f opts -> return $ optAddInclDir f opts) "DIR")
120         "Add a directory to the search path where Sockeye looks for imports."
121     , Option "o" ["output-file"]
122         (ReqArg (\f opts -> return $ optSetOutputFile f opts) "FILE")
123         "Output file in which to store the compilation result (required)."
124     , Option "d" ["dep-file"]
125         (ReqArg (\f opts -> return $ optSetDepFile f opts) "FILE")
126         "Generate a dependency file for GNU make"
127     , Option "h" ["help"]
128         (NoArg (\_ -> do
129                     usage []
130                     exitWith ExitSuccess))
131         "Show help."
132     ]
133
134 {- evaluates the compiler options -}
135 compilerOpts :: [String] -> IO (Options)
136 compilerOpts argv = do
137     opts <- case getOpt Permute options argv of
138         (actions, fs, []) -> do
139             opts <- foldl (>>=) (return defaultOptions) actions
140             case fs of
141                 []  -> do
142                     usage ["No input file\n"]
143                     exitWith usageError
144                 [f] -> return $ optSetInputFileName f opts
145                 _   -> do
146                     usage ["Multiple input files not supported\n"]
147                     exitWith usageError
148
149         (_, _, errors) -> do
150             usage errors
151             exitWith $ usageError
152     case optOutputFile opts of
153         "" -> do
154             usage ["No output file\n"]
155             exitWith $ usageError
156         _  -> return opts
157
158 {- Parse Sockeye and resolve imports -}
159 parseSpec :: [FilePath] -> FilePath -> IO (ParseAST.SockeyeSpec, [FilePath])
160 parseSpec inclDirs fileName = do
161     file <- resolveFile fileName
162     specMap <- parseWithImports Map.empty file
163     let
164         specs = Map.elems specMap
165         deps = Map.keys specMap
166         topLevelSpec = specMap Map.! file
167         modules = concat $ map ParseAST.modules specs
168         spec = topLevelSpec
169             { ParseAST.imports = []
170             , ParseAST.modules = modules
171             }
172     return (spec, deps)
173     where
174         parseWithImports importMap importPath = do
175             file <- resolveFile importPath
176             if file `Map.member` importMap
177                 then return importMap
178                 else do
179                     ast <- parseFile file
180                     let
181                         specMap = Map.insert file ast importMap
182                         imports = ParseAST.imports ast
183                         importFiles = map ParseAST.filePath imports
184                     foldM parseWithImports specMap importFiles
185         resolveFile path = do
186             let
187                 subDir = takeDirectory path
188                 name = takeFileName path
189                 dirs = map (</> subDir) inclDirs
190             file <- findFile dirs name
191             extFile <- findFile dirs (name <.> "soc")
192             case (file, extFile) of
193                 (Just f, _) -> return f
194                 (_, Just f) -> return f
195                 _ -> do
196                     hPutStrLn stderr $ "'" ++ path ++ "' not on import path"
197                     exitWith fileError
198
199
200 {- Runs the parser on a single file -}
201 parseFile :: FilePath -> IO (ParseAST.SockeyeSpec)
202 parseFile file = do
203     src <- readFile file
204     case parseSockeye file src of
205         Left err -> do
206             hPutStrLn stderr $ "Parse error at " ++ show err
207             exitWith parseError
208         Right ast -> return ast
209
210 {- Runs the checker -}
211 checkAST :: ParseAST.SockeyeSpec -> IO AST.SockeyeSpec
212 checkAST parsedAst = do
213     case checkSockeye parsedAst of 
214         Left fail -> do
215             hPutStr stderr $ show fail
216             exitWith checkError
217         Right intermAst -> return intermAst
218
219 instanitateModules :: AST.SockeyeSpec -> IO InstAST.SockeyeSpec
220 instanitateModules ast = do
221     case sockeyeInstantiate ast of 
222         Left fail -> do
223             hPutStr stderr $ show fail
224             exitWith buildError
225         Right simpleAST -> return simpleAST
226
227 {- Builds the decoding net from the Sockeye AST -}
228 buildNet :: AST.SockeyeSpec -> IO NetAST.NetSpec
229 buildNet ast = do
230     case sockeyeBuildNet ast of 
231         Left fail -> do
232             hPutStr stderr $ show fail
233             exitWith buildError
234         Right netAst -> return netAst
235
236 {- Compiles the AST with the appropriate backend -}
237 compile :: Target -> NetAST.NetSpec -> IO String
238 compile Prolog ast = return $ Prolog.compile ast
239
240 {- Writes a dependency file for GNU make -}
241 dependencyFile :: FilePath -> FilePath -> [FilePath] -> IO String
242 dependencyFile outFile depFile deps = do
243     let
244         targets = outFile ++ " " ++ depFile ++ ":"
245         lines = targets:deps
246     return $ intercalate " \\\n " lines
247
248 {- Outputs the compilation result -}
249 output :: FilePath -> String -> IO ()
250 output outFile out = writeFile outFile out
251
252 main = do
253     args <- getArgs
254     opts <- compilerOpts args
255     let
256         inFile = optInputFile opts
257         inclDirs = optInclDirs opts
258         outFile = optOutputFile opts
259         depFile = optDepFile opts
260     (parsedAst, deps) <- parseSpec inclDirs inFile
261     case depFile of
262         Nothing -> return ()
263         Just f  -> do
264             out <- dependencyFile outFile f deps
265             output f out
266     ast <- checkAST parsedAst
267     instAST <- instanitateModules ast
268     putStrLn $ groom instAST
269     netAst <- buildNet ast
270     out <- compile (optTarget opts) netAst
271     output outFile out
272