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