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