Sockeye: Fix import system
[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 qualified Data.Map as Map
19
20 import System.Console.GetOpt
21 import System.Exit
22 import System.Environment
23 import System.FilePath
24 import System.IO
25
26 import qualified SockeyeASTParser as ParseAST
27 import qualified SockeyeAST as AST
28 import qualified SockeyeASTDecodingNet as NetAST
29
30 import SockeyeParser
31 import SockeyeChecker
32 import SockeyeNetBuilder
33
34 import qualified SockeyeBackendProlog as Prolog
35
36 {- Exit codes -}
37 usageError :: ExitCode
38 usageError = ExitFailure 1
39
40 parseError :: ExitCode
41 parseError = ExitFailure 2
42
43 checkError :: ExitCode
44 checkError = ExitFailure 3
45
46 buildError :: ExitCode
47 buildError = ExitFailure 4
48
49 {- Compilation targets -}
50 data Target = None | Prolog
51
52 {- Possible options for the Sockeye Compiler -}
53 data Options = Options { optInputFile  :: FilePath
54                        , optTarget     :: Target
55                        , optOutputFile :: Maybe FilePath
56                        }
57
58 {- Default options -}
59 defaultOptions :: Options
60 defaultOptions = Options { optInputFile  = ""
61                          , optTarget     = Prolog
62                          , optOutputFile = Nothing
63                          }
64
65 {- Set the input file name -}
66 optSetInputFileName :: FilePath -> Options -> Options
67 optSetInputFileName f o = o { optInputFile = f }
68
69 {- Set the target -}
70 optSetTarget :: Target -> Options -> Options
71 optSetTarget t o = o { optTarget = t }
72
73 {- Set the outpue file name -}
74 optSetOutputFile :: Maybe String -> Options -> Options
75 optSetOutputFile f o = o { optOutputFile = f }
76
77 {- Prints usage information possibly with usage errors -}
78 usage :: [String] -> IO ()
79 usage errors = do
80     prg <- getProgName
81     let usageString = "Usage: " ++ prg ++ " [options] file\nOptions:"
82     hPutStrLn stderr $ usageInfo (concat errors ++ usageString) options
83     hPutStrLn stderr "The backend (capital letter options) specified last takes precedence."
84
85
86 {- Setup option parser -}
87 options :: [OptDescr (Options -> IO Options)]
88 options = 
89     [ Option "P" ["Prolog"]
90         (NoArg (\opts -> return $ optSetTarget Prolog opts))
91         "Generate a prolog file that can be loaded into the SKB (default)."
92     , Option "C" ["Check"]
93         (NoArg (\opts -> return $ optSetTarget None opts))
94         "Just check the file, do not compile."
95     , Option "o" ["output-file"]
96         (ReqArg (\f opts -> return $ optSetOutputFile (Just f) opts) "FILE")
97         "If no output file is specified the compilation result is written to stdout."
98     , Option "h" ["help"]
99         (NoArg (\_ -> do
100                     usage []
101                     exitWith ExitSuccess))
102         "Show help."
103     ]
104
105 {- evaluates the compiler options -}
106 compilerOpts :: [String] -> IO (Options)
107 compilerOpts argv =
108     case getOpt Permute options argv of
109         (actions, fs, []) -> do
110             opts <- foldl (>>=) (return defaultOptions) actions
111             case fs of
112                 []  -> do
113                     usage ["No input file\n"]
114                     exitWith usageError
115                 [f] -> return $ optSetInputFileName f opts
116                 _   -> do
117                     usage ["Multiple input files not supported\n"]
118                     exitWith usageError
119
120         (_, _, errors) -> do
121             usage errors
122             exitWith $ usageError
123
124 {- Parse Sockeye and resolve imports -}
125 parseSpec :: FilePath -> IO (ParseAST.SockeyeSpec)
126 parseSpec file = do
127     let
128         rootImport = ParseAST.Import file
129     specMap <- parseWithImports "" Map.empty rootImport
130     let
131         specs = Map.elems specMap
132         topLevelSpec = specMap Map.! file
133         modules = concat $ map ParseAST.modules specs
134     return topLevelSpec
135         { ParseAST.imports = []
136         , ParseAST.modules = modules
137         }
138     where
139         parseWithImports pwd importMap (ParseAST.Import filePath) = do
140             let
141                 dir = case pwd of
142                     "" -> takeDirectory filePath
143                     _  -> pwd </> takeDirectory filePath
144                 fileName = takeFileName filePath
145                 file = if '.' `elem` fileName
146                     then dir </> fileName
147                     else dir </> fileName <.> "soc"
148             if file `Map.member` importMap
149                 then return importMap
150                 else do
151                     ast <- parseFile file
152                     let
153                         specMap = Map.insert file ast importMap
154                         imports = ParseAST.imports ast
155                     foldM (parseWithImports dir) specMap imports
156
157 {- Runs the parser on a single file -}
158 parseFile :: FilePath -> IO (ParseAST.SockeyeSpec)
159 parseFile file = do
160     src <- readFile file
161     case parseSockeye file src of
162         Left err -> do
163             hPutStrLn stderr $ "Parse error at " ++ show err
164             exitWith parseError
165         Right ast -> return ast
166
167 {- Runs the checker -}
168 checkAST :: ParseAST.SockeyeSpec -> IO AST.SockeyeSpec
169 checkAST parsedAst = do
170     case checkSockeye parsedAst of 
171         Left fail -> do
172             hPutStr stderr $ show fail
173             exitWith checkError
174         Right intermAst -> return intermAst
175
176 {- Builds the decoding net from the Sockeye AST -}
177 buildNet :: AST.SockeyeSpec -> IO NetAST.NetSpec
178 buildNet ast = do
179     case sockeyeBuildNet ast of 
180         Left fail -> do
181             hPutStr stderr $ show fail
182             exitWith buildError
183         Right netAst -> return netAst
184
185 {- Compiles the AST with the appropriate backend -}
186 compile :: Target -> NetAST.NetSpec -> IO String
187 compile None     _   = return ""
188 compile Prolog   ast = return $ Prolog.compile ast
189
190 {- Outputs the compilation result -}
191 output :: Maybe FilePath -> String -> IO ()
192 output outFile out = do
193     case outFile of
194         Nothing -> putStr out
195         Just f  -> writeFile f out
196
197 main = do
198     args <- getArgs
199     opts <- compilerOpts args
200     let inFile = optInputFile opts
201     parsedAst <- parseSpec inFile
202     ast <- checkAST parsedAst
203     netAst <- buildNet ast
204     out <- compile (optTarget opts) netAst
205     output (optOutputFile opts) out
206