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