-- module Language.Java.Paragon where import Language.Java.Paragon.Syntax import Language.Java.Paragon.Parser import Language.Java.Paragon.Pretty import Language.Java.Paragon.TypeCheck import Language.Java.Paragon.Compile import Language.Java.Paragon.PiGeneration --import Language.Java.Paragon.TypeCheck.TcEnv --import Language.Java.Paragon.TypeCheck.Locks --import Language.Java.Paragon.TypeCheck.Policy --import qualified Language.Java.Paragon.TypeCheck.Types as TP import Language.Java.Paragon.Verbosity import System.FilePath import System.Environment import System.Directory import Control.Monad import qualified Data.Map as DM import Data.Maybe import System.Console.GetOpt ------------------------------------------------------------------------------------- main :: IO () main = do (flags, files) <- compilerOpts =<< getArgs mapM_ setVerbosity $ [ k | Verbose k <- flags ] when (Version `elem` flags) $ normalPrint versionString when (Help `elem` flags) $ normalPrint $ usageInfo usageHeader options when (not (null files)) $ compile flags (head files) -- TODO: Enable multiple files data Flag = Verbose Int | Version | Help | PiPath String deriving (Show, Eq) versionString, usageHeader :: String versionString = "Paragon Compiler version: 0.1.5" usageHeader = "Usage: parac [OPTION...] files..." options :: [OptDescr Flag] options = [ Option ['v'] ["verbose"] (OptArg (Verbose . maybe 3 read) "n") "Control verbosity (n is 0--4, normal verbosity level is 1, -v alone is equivalent to -v3" , Option ['V'] ["version"] (NoArg Version) "Show version number" , Option ['h','?'] ["help"] (NoArg Help) "Show this help" , Option ['p'] ["pipath"] (ReqArg PiPath "") "Path to the root directory for Paragon interface (.pi) files (default is . )" ] compilerOpts :: [String] -> IO ([Flag], [String]) compilerOpts argv = case getOpt RequireOrder options argv of (o,n,[]) -> return (o,n) (_,_,errs) -> ioError (userError (concat errs ++ usageInfo usageHeader options)) ------------------------------------------------------------------------------------- --type ErrM = Either String liftE :: Show e => Either e a -> IO a liftE eea = case eea of Right a -> return a Left e -> fail $ show e compile :: [Flag] -> String -> IO () compile flags filePath = do let (directory,fileName) = splitFileName filePath --relative or absolute path? let pDir = case [ dir | PiPath dir <- flags ] of p:_ -> p _ -> "." fc <- readFile filePath ast <- liftE $ parser compilationUnit fc extraPrint "Parsing complete!" ast2 <- typeCheck directory pDir ast extraPrint "Type checking complete!" genFiles filePath ast2 extraPrint "File generation complete!" genFiles :: FilePath -> CompilationUnit -> IO () genFiles filePath ast = let astC = compileTransform ast astPi = piTransform ast baseName = takeBaseName filePath directory = takeDirectory filePath javaPath = directory baseName <.> "java" piPath = directory baseName <.> "pi" java,pi :: String java = prettyPrint astC pi = prettyPrint astPi in writeFile javaPath java >> writeFile piPath pi