Sockeye: Implement import support
[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
19 import Data.Map (Map)
20 import qualified Data.Map as Map
21
22 import System.Console.GetOpt
23 import System.Exit
24 import System.Environment
25 import System.IO
26
27 import qualified SockeyeASTParser as ParseAST
28 import qualified SockeyeAST as AST
29 import qualified SockeyeASTDecodingNet as NetAST
30
31 import SockeyeParser
32 import SockeyeChecker
33 import SockeyeNetBuilder
34
35 import qualified SockeyeBackendProlog as Prolog
36
37 import Debug.Trace
38 import Text.Groom(groom)
39
40 {- Exit codes -}
41 usageError :: ExitCode
42 usageError = ExitFailure 1
43
44 parseError :: ExitCode
45 parseError = ExitFailure 2
46
47 checkError :: ExitCode
48 checkError = ExitFailure 3
49
50 buildError :: ExitCode
51 buildError = ExitFailure 4
52
53 {- Compilation targets -}
54 data Target = None | Prolog
55
56 {- Possible options for the Sockeye Compiler -}
57 data Options = Options { optInputFile  :: FilePath
58                        , optTarget     :: Target
59                        , optOutputFile :: Maybe FilePath
60                        }
61
62 {- Default options -}
63 defaultOptions :: Options
64 defaultOptions = Options { optInputFile  = ""
65                          , optTarget     = Prolog
66                          , optOutputFile = Nothing
67                          }
68
69 {- Set the input file name -}
70 optSetInputFileName :: FilePath -> Options -> Options
71 optSetInputFileName f o = o { optInputFile = f }
72
73 {- Set the target -}
74 optSetTarget :: Target -> Options -> Options
75 optSetTarget t o = o { optTarget = t }
76
77 {- Set the outpue file name -}
78 optSetOutputFile :: Maybe String -> Options -> Options
79 optSetOutputFile f o = o { optOutputFile = f }
80
81 {- Prints usage information possibly with usage errors -}
82 usage :: [String] -> IO ()
83 usage errors = do
84     prg <- getProgName
85     let usageString = "Usage: " ++ prg ++ " [options] file\nOptions:"
86     hPutStrLn stderr $ usageInfo (concat errors ++ usageString) options
87     hPutStrLn stderr "The backend (capital letter options) specified last takes precedence."
88
89
90 {- Setup option parser -}
91 options :: [OptDescr (Options -> IO Options)]
92 options = 
93     [ Option "P" ["Prolog"]
94         (NoArg (\opts -> return $ optSetTarget Prolog opts))
95         "Generate a prolog file that can be loaded into the SKB (default)."
96     , Option "C" ["Check"]
97         (NoArg (\opts -> return $ optSetTarget None opts))
98         "Just check the file, do not compile."
99     , Option "o" ["output-file"]
100         (ReqArg (\f opts -> return $ optSetOutputFile (Just f) opts) "FILE")
101         "If no output file is specified the compilation result is written to stdout."
102     , Option "h" ["help"]
103         (NoArg (\_ -> do
104                     usage []
105                     exitWith ExitSuccess))
106         "Show help."
107     ]
108
109 {- evaluates the compiler options -}
110 compilerOpts :: [String] -> IO (Options)
111 compilerOpts argv =
112     case getOpt Permute options argv of
113         (actions, fs, []) -> do
114             opts <- foldl (>>=) (return defaultOptions) actions
115             case fs of
116                 []  -> do
117                     usage ["No input file\n"]
118                     exitWith usageError
119                 [f] -> return $ optSetInputFileName f opts
120                 _   -> do
121                     usage ["Multiple input files not supported\n"]
122                     exitWith usageError
123
124         (_, _, errors) -> do
125             usage errors
126             exitWith $ usageError
127
128 {- Parse Sockeye and resolve imports -}
129 parseSpec :: FilePath -> IO (ParseAST.SockeyeSpec)
130 parseSpec file = do
131     let
132         rootImport = ParseAST.Import file
133     specMap <- parseWithImports Map.empty rootImport
134     let
135         specs = Map.elems specMap
136         topLevelSpec = specMap Map.! file
137         modules = concat $ map ParseAST.modules specs
138     return topLevelSpec
139         { ParseAST.imports = []
140         , ParseAST.modules = modules
141         }
142     where
143         parseWithImports importMap (ParseAST.Import fileName) = do
144             let
145                 file = if '.' `elem` fileName
146                     then fileName
147                     else 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 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     -- trace (groom parsedAst) $ return ()
203     ast <- checkAST parsedAst
204     netAst <- buildNet ast
205     out <- compile (optTarget opts) netAst
206     output (optOutputFile opts) out
207