Rename sockey2 -> sockeye
[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 import Data.List
18 import System.Console.GetOpt
19 import System.Exit
20 import System.Environment
21 import System.IO
22
23 import SockeyeAST as AST
24 import SockeyeParser
25 import SockeyeChecker
26 import qualified SockeyeBackendPrintAST as PrintAST
27 import qualified SockeyeBackendProlog as Prolog
28
29 {- Compilation targets -}
30 data Target = None | PrintAST | Prolog
31
32 {- Possible options for the Sockeye Compiler -}
33 data Options = Options { optInputFile  :: FilePath
34                        , optTarget     :: Target
35                        , optOutputFile :: Maybe FilePath
36                        }
37
38 {- Default options -}
39 defaultOptions :: Options
40 defaultOptions = Options { optInputFile  = ""
41                          , optTarget     = Prolog
42                          , optOutputFile = Nothing
43                          }
44
45 {- Set the input file name -}
46 optSetInputFileName :: FilePath -> Options -> Options
47 optSetInputFileName f o = o { optInputFile = f }
48
49 {- Set the target -}
50 optSetTarget :: Target -> Options -> Options
51 optSetTarget t o = o { optTarget = t }
52
53 {- Set the outpue file name -}
54 optSetOutputFile :: Maybe String -> Options -> Options
55 optSetOutputFile f o = o { optOutputFile = f }
56
57 {- Prints usage information possibly with usage errors -}
58 usage :: [String] -> IO ()
59 usage errors = do
60     prg <- getProgName
61     let usageString = "Usage: " ++ prg ++ " [options] file\nOptions:"
62     hPutStrLn stderr $ usageInfo (concat errors ++ usageString) options
63     hPutStrLn stderr "The backend (capital letter options) specified last takes precedence."
64
65
66 {- Setup option parser -}
67 options :: [OptDescr (Options -> IO Options)]
68 options = 
69     [ Option "P" ["Prolog"]
70         (NoArg (\opts -> return $ optSetTarget Prolog opts))
71         "Generate a prolog file that can be loaded into the SKB (default)."
72     , Option "A" ["AST"]
73         (NoArg (\opts -> return $ optSetTarget PrintAST opts))
74         "Print the AST."
75     , Option "C" ["Check"]
76         (NoArg (\opts -> return $ optSetTarget None opts))
77         "Just check the file, do not compile."
78     , Option "o" ["output-file"]
79         (ReqArg (\f opts -> return $ optSetOutputFile (Just f) opts) "FILE")
80         "If no output file is specified the compilation result is written to stdout."
81     , Option "h" ["help"]
82         (NoArg (\_ -> do
83                     usage []
84                     exitWith ExitSuccess))
85         "Show help."
86     ]
87
88 {- evaluates the compiler options -}
89 compilerOpts :: [String] -> IO (Options)
90 compilerOpts argv =
91     case getOpt Permute options argv of
92         (actions, fs, []) -> do
93             opts <- foldl (>>=) (return defaultOptions) actions
94             case fs of []  -> do
95                                 usage ["No input file\n"]
96                                 exitWith $ ExitFailure 1
97                        [f] -> return $ optSetInputFileName f opts
98                        _   -> do
99                                 usage ["Multiple input files not supported\n"]
100                                 exitWith $ ExitFailure 1
101
102         (_, _, errors) -> do
103             usage errors
104             exitWith $ ExitFailure 1
105
106 {- Runs the parser -}
107 parseFile :: FilePath -> IO (AST.NetSpec)
108 parseFile file = do
109     src <- readFile file
110     case parseSockeye file src of
111         Left err -> do
112             hPutStrLn stderr $ "Parse error at " ++ show err
113             exitWith $ ExitFailure 2
114         Right ast -> return ast
115
116 {- Runs the checker -}
117 checkAST :: AST.NetSpec -> IO ()
118 checkAST ast = do
119     case checkSockeye ast of 
120         [] -> return ()
121         errors -> do
122             hPutStr stderr $ unlines (foldl flattenErrors ["Failed checks:"] errors)
123             exitWith $ ExitFailure 3
124         where flattenErrors es (key, errors)
125                 = let indented = map ((replicate 4 ' ') ++) errors
126                   in es ++ case key of Nothing     -> errors
127                                        Just nodeId -> ("In specification of node '" ++ show nodeId ++ "':"):indented
128
129 {- Compiles the AST with the appropriate backend -}
130 compile :: Target -> AST.NetSpec -> IO String
131 compile None     _   = return ""
132 compile PrintAST ast = return $ PrintAST.compile ast
133 compile Prolog   ast = return $ Prolog.compile ast
134
135 {- Outputs the compilation result -}
136 output :: Maybe FilePath -> String -> IO ()
137 output outFile out = do
138     case outFile of Nothing -> putStr out
139                     Just f  -> writeFile f out
140
141 main = do
142     args <- getArgs
143     opts <- compilerOpts args
144     let inFile = optInputFile opts
145     ast <- parseFile inFile
146     checkAST ast
147     out <- compile (optTarget opts) ast
148     output (optOutputFile opts) out
149