1{-
2  Skate: a strawman device definition DSL for Barrelfish
3
4  Copyright (c) 2017 ETH Zurich.
5  All rights reserved.
6
7  This file is distributed under the terms in the attached LICENSE file.
8  If you do not find this file, copies can be found by writing to:
9  ETH Zurich D-INFK, Universitaetsstrasse 6, CH-8092 Zurich.
10  Attn: Systems Group.
11-}
12
13
14
15module Main where
16
17import System.Environment
18import System.Exit
19import System.Console.GetOpt
20import System.IO
21import System.IO.Error
22import System.FilePath.Posix
23import Data.Maybe
24import Data.List
25import Control.Monad
26import Control.Exception
27import Text.Printf
28
29import Text.ParserCombinators.Parsec as Parsec
30
31import qualified SkateParser
32import qualified SkateBackendCode
33import qualified SkateBackendHeader
34import qualified SkateBackendLatex
35import qualified SkateBackendWiki
36import qualified SkateSchema
37import qualified SkateChecker
38
39
40
41
42{- Compilation Targets -}
43data Target = Header | Code | Wiki | Latex deriving (Eq, Show)
44
45{- Architecture to build for -}
46data Arch = X86_64 | ARMv7 | ARMv8 deriving (Eq, Show)
47
48{- Possible Options -}
49data Options = Options {
50  opt_infilename  :: Maybe String,
51  opt_outfilename :: Maybe String,
52  opt_includes    :: [String],
53  opt_targets     :: Target,
54  opt_usage_error :: Bool,
55  opt_verbosity   :: Integer,
56  opt_arch        :: Arch
57  } deriving (Show,Eq)
58
59{- The default options for Skate-}
60defaultOptions :: Options
61defaultOptions    = Options {
62  opt_infilename  = Nothing,
63  opt_outfilename = Nothing,
64  opt_includes    = [],
65  opt_targets     = Header,
66  opt_usage_error = False,
67  opt_verbosity   = 0,
68  opt_arch        = X86_64 }
69
70
71{- Adds a new target to the list of targets -}
72optSetTarget :: Target -> Options -> Options
73optSetTarget t o =  o { opt_targets = t }
74
75{- Adds a new include to the list of includes -}
76optAddInclude :: String -> Options -> Options
77optAddInclude s o = o { opt_includes = (opt_includes o) ++ [s] }
78
79{- Adds a new include to the list of includes -}
80optSetVerbosity :: Integer -> Options -> Options
81optSetVerbosity i o = o { opt_verbosity = i }
82
83{- Adds a new target to the list of targets -}
84optSetOutFile :: String -> Options -> Options
85optSetOutFile s o = o { opt_outfilename = Just s }
86
87{- Adds a new target to the list of targets -}
88optSetInFile :: String -> Options -> Options
89optSetInFile s o = o { opt_infilename = Just s }
90
91optSetArch :: String -> Options -> Options
92optSetArch "x86_64" o =  o { opt_arch = X86_64 }
93optSetArch "armv7" o =  o { opt_arch = ARMv7 }
94optSetArch "armv8" o =  o { opt_arch = ARMv8 }
95
96
97
98{- Set the option parser Systems.GetOpt -}
99options :: [OptDescr (Options -> Options)]
100options = [ --Option ['c'] ["input-file"]
101    --(ReqArg (\f opts -> opts { opt_infilename = Just f } ) "file")
102    --"input file",
103    Option ['I']
104           ["import"]
105           (ReqArg (\ f opts -> optAddInclude f opts) "file.sks" )
106           "Include a given file before processing",
107
108    Option ['v']
109           ["verbose"]
110           (NoArg (\ opts -> optSetVerbosity 1 opts ))
111           "increase verbosity level",
112
113    Option ['o']
114           ["output"]
115           (ReqArg (\ f opts -> optSetOutFile f opts ) "file.out")
116           "output file name",
117
118    Option ['H']
119           ["header"]
120           (NoArg (\ opts -> optSetTarget Header opts))
121           "Create a header file",
122
123    Option ['C']
124           ["code"]
125           (NoArg (\ opts -> optSetTarget Code opts))
126           "Create code",
127
128    Option ['L']
129           ["latex"]
130           (NoArg (\ opts -> optSetTarget Latex opts))
131           "add documentation target",
132
133    Option ['W']
134           ["wiki"]
135           (NoArg (\ opts -> optSetTarget Wiki opts))
136           "add documentation target",
137
138    Option ['a']
139           ["arch"]
140           (ReqArg (\ a opts -> optSetArch a opts) "x86_64")
141           "add architecture. one of x86_64, armv7, armv8"
142  ]
143
144
145{- prints an error message if wrong options are supplied -}
146usageError :: [String] -> IO (Options)
147usageError errs =
148  ioError (userError (concat errs ++ usageInfo usage options))
149  where usage = "Usage: Skate <options> <input file>"
150
151
152{- evaluates the compiler options -}
153compilerOpts :: [String] -> IO (Options)
154compilerOpts argv =
155  case getOpt Permute options argv of
156    (o,[n],[]) -> return ( optSetInFile n (foldl (flip id) defaultOptions o) )
157    (_,_,errs) -> usageError errs
158
159
160getGenerator :: Options -> Target -> String -> String -> SkateSchema.SchemaRecord -> String
161getGenerator _ Header = SkateBackendHeader.compile
162getGenerator _ Code = SkateBackendCode.compile
163getGenerator _ Latex = SkateBackendLatex.compile
164getGenerator _ Wiki = SkateBackendWiki.compile
165
166
167
168{- compile the backend codes -}
169compile :: Options -> Target -> SkateSchema.SchemaRecord -> String -> String
170           -> Handle -> IO ()
171compile opts fl ast infile outfile outfiled =
172    hPutStr outfiled $ (getGenerator opts fl) infile outfile ast
173 -- where
174 --     ast' = SkateTools.rewireTypes ast (SkateTools.collectTypes ast)
175
176
177
178{- parses the file -}
179parseFile :: String -> IO SkateParser.Schema
180parseFile fname = do
181    src <- readFile fname
182    case (runParser SkateParser.parse () fname src) of
183        Left err -> ioError $ userError ("Parse error at: " ++ (show err))
184        Right x -> return x
185
186
187
188
189
190{- Resolve the imports in the files -}
191findImport :: [String] -> String -> IO SkateParser.Schema
192findImport [] f =  ioError (userError $ printf "Can't find import '%s'" f)
193findImport (d:t) f =  do
194    catch (parseFile (d </> f))
195      (\e -> (if isDoesNotExistError e then findImport t f else ioError e))
196
197resolveImp :: [SkateParser.Schema] -> [String] -> IO [SkateParser.Schema]
198resolveImp dfl path =
199    let
200        allimports = nub $ concat [ i | (SkateParser.Schema n _ _ i _) <- dfl ]
201        gotimports = [ n | (SkateParser.Schema n _ _ i _) <- dfl ]
202        required = allimports \\ gotimports
203    in
204        case required of
205            [] -> return dfl
206            (t:_) -> do {
207                i <- (findImport path (t ++ ".sks"));
208                resolveImp (dfl ++ [i]) path }
209
210
211
212{- The Main Entry Point of Skate-}
213main :: IO ()
214main = do {
215    cli <- System.Environment.getArgs;
216    opts <- compilerOpts cli;
217    let
218        inFile = fromJust $ opt_infilename opts
219        outFile = fromJust $ opt_outfilename opts
220        target = opt_targets opts
221        dfl  = []
222    in
223        do {
224            printf "Start parsing '%s'\n" inFile;
225            ast  <- parseFile inFile;
226            dfl  <- resolveImp [ast] (opt_includes opts);
227            st <- SkateSchema.make_schema_record ast (tail dfl);
228            printf "output parsing '%s'\n" outFile;
229            _ <- SkateChecker.run_all_checks inFile st;
230            outFileD <- openFile outFile WriteMode;
231            compile opts target st inFile outFile outFileD;
232            hClose outFileD
233        }
234    }
235