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