Commit e55567eb authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

CompilerOptions improved

parent 3fb4cf36
......@@ -14,8 +14,8 @@
compilation of Curry programs.
-}
module CompilerOpts
( Options (..), Verbosity (..), TargetType (..), Extension (..)
, DumpLevel (..), defaultOptions, compilerOpts, usage
( Options (..), CymakeMode (..), Verbosity (..), TargetType (..)
, Extension (..), DumpLevel (..), defaultOptions, compilerOpts, usage
) where
import Data.List (intercalate, nub)
......@@ -29,42 +29,48 @@ import Curry.Files.Filenames (currySubdir)
-- |Data type for recording compiler options
data Options = Options
-- general
{ optHelp :: Bool -- ^ show help
, optVersion :: Bool -- ^ show the version
, optHtml :: Bool -- ^ generate Html code
, optVerbosity :: Verbosity -- ^ verbosity level
{ optMode :: CymakeMode -- ^ show help
, optVerbosity :: Verbosity -- ^ verbosity level
-- compilation
, optForce :: Bool -- ^ force compilation of target
, optImportPaths :: [FilePath] -- ^ directories for imports
, optOutput :: Maybe FilePath -- ^ name of output file
, optUseSubdir :: Bool -- ^ use subdir for output?
, optInterface :: Bool -- ^ create an interface file
, optWarn :: Bool -- ^ show warnings
, optOverlapWarn :: Bool -- ^ show "overlap" warnings
, optTargetTypes :: [TargetType] -- ^ what to generate
, optExtensions :: [Extension] -- ^ enabled language extensions
, optDumps :: [DumpLevel] -- ^ dump levels
, optForce :: Bool -- ^ force compilation of target
, optLibraryPaths :: [FilePath] -- ^ directories for libraries
, optImportPaths :: [FilePath] -- ^ directories for imports
, optOutput :: Maybe FilePath -- ^ name of output file
, optUseSubdir :: Bool -- ^ use subdir for output?
, optInterface :: Bool -- ^ create an interface file
, optWarn :: Bool -- ^ show warnings
, optOverlapWarn :: Bool -- ^ show "overlap" warnings
, optTargetTypes :: [TargetType] -- ^ what to generate
, optExtensions :: [Extension] -- ^ enabled language extensions
, optDumps :: [DumpLevel] -- ^ dump levels
}
-- | Default compiler options
defaultOptions :: Options
defaultOptions = Options
{ optHelp = False
, optVersion = False
, optHtml = False
, optVerbosity = VerbStatus
, optForce = False
, optImportPaths = []
, optOutput = Nothing
, optUseSubdir = True
, optInterface = True
, optWarn = True
, optOverlapWarn = True
, optTargetTypes = []
, optExtensions = []
, optDumps = []
{ optMode = ModeMake
, optVerbosity = VerbStatus
, optForce = False
, optLibraryPaths = []
, optImportPaths = []
, optOutput = Nothing
, optUseSubdir = True
, optInterface = True
, optWarn = True
, optOverlapWarn = True
, optTargetTypes = []
, optExtensions = []
, optDumps = []
}
data CymakeMode
= ModeHelp
| ModeVersion
| ModeNumericVersion
| ModeHtml
| ModeMake
deriving Eq
-- |Type of the target file
data TargetType
= Parsed -- ^ Parsed source code
......@@ -128,16 +134,20 @@ classifyExtension str = case reads str of
-- | All available compiler options
options :: [OptDescr (Options -> Options)]
options =
-- general
-- modus operandi
[ Option "h?" ["help"]
(NoArg (\ opts -> opts { optHelp = True }))
(NoArg (\ opts -> opts { optMode = ModeHelp }))
"display this help and exit"
, Option "V" ["version"]
(NoArg (\ opts -> opts { optVersion = True }))
"show the version number"
(NoArg (\ opts -> opts { optMode = ModeVersion }))
"show the version number and exit"
, Option "" ["numeric-version"]
(NoArg (\ opts -> opts { optMode = ModeNumericVersion }))
"show the numeric version number and exit"
, Option "" ["html"]
(NoArg (\ opts -> opts { optHtml = True }))
"generate html code"
(NoArg (\ opts -> opts { optMode = ModeHtml }))
"generate html code and exit"
-- verbosity
, Option "v" ["verbosity"]
(ReqArg (\ arg opts -> opts { optVerbosity =
classifyVerbosity arg $ optVerbosity opts}) "<n>")
......@@ -149,10 +159,14 @@ options =
, Option "f" ["force"]
(NoArg (\ opts -> opts { optForce = True }))
"force compilation of target file"
, Option "P" ["lib-dir"]
(ReqArg (\ arg opts -> opts { optLibraryPaths =
nub $ optLibraryPaths opts ++ splitSearchPath arg}) "dir:dir2:...")
"search for librares in dir:dir2:..."
, Option "i" ["import-dir"]
(ReqArg (\ arg opts -> opts { optImportPaths =
nub $ optImportPaths opts ++ splitSearchPath arg}) "DIR")
"search for imports in DIR"
nub $ optImportPaths opts ++ splitSearchPath arg}) "dir:dir2:...")
"search for imports in dir:dir2:..."
, Option "o" ["output"]
(ReqArg (\ arg opts -> opts { optOutput = Just arg }) "FILE")
"write code to FILE"
......
......@@ -50,14 +50,14 @@ type SourceEnv = Map.Map ModuleIdent Source
-- |Retrieve the dependencies of a source file in topological order
-- and possible errors during flattering
flatDeps :: Options -> FilePath -> IO ([(ModuleIdent, Source)], [String])
flatDeps opts fn = flattenDeps `liftM` deps opts [] Map.empty fn
flatDeps opts fn = flattenDeps `liftM` deps opts Map.empty fn
-- |Retrieve the dependencies of a source file as a 'SourceEnv'
deps :: Options -> [FilePath] -> SourceEnv -> FilePath -> IO SourceEnv
deps opts paths sEnv fn
deps :: Options -> SourceEnv -> FilePath -> IO SourceEnv
deps opts sEnv fn
| ext == icurryExt = return Map.empty
| ext `elem` sourceExts = sourceDeps opts paths sEnv fn
| otherwise = targetDeps opts paths sEnv fn
| ext `elem` sourceExts = sourceDeps opts sEnv fn
| otherwise = targetDeps opts sEnv fn
where ext = takeExtension fn
-- The following functions are used to lookup files related to a given
......@@ -76,31 +76,31 @@ deps opts paths sEnv fn
-- prelude itself.
-- |Retrieve the dependencies of a given target file
targetDeps :: Options -> [FilePath] -> SourceEnv -> FilePath -> IO SourceEnv
targetDeps opts paths sEnv fn = do
targetDeps :: Options -> SourceEnv -> FilePath -> IO SourceEnv
targetDeps opts sEnv fn = do
mFile <- lookupFile [""] sourceExts fn
case mFile of
Nothing -> return $ Map.insert (mkMIdent [fn]) Unknown sEnv
Just file -> sourceDeps opts paths sEnv file
Just file -> sourceDeps opts sEnv file
-- |Retrieve the dependencies of a given source file
sourceDeps :: Options -> [FilePath] -> SourceEnv -> FilePath -> IO SourceEnv
sourceDeps opts paths sEnv fn = do
sourceDeps :: Options -> SourceEnv -> FilePath -> IO SourceEnv
sourceDeps opts sEnv fn = do
mbFile <- readModule fn
case mbFile of
Nothing -> internalError $ "CurryDeps.sourceDeps: missing file " ++ fn
Just file -> do
let hdr = patchModuleId fn $ ok $ parseHeader fn file
moduleDeps opts paths sEnv fn hdr
moduleDeps opts sEnv fn hdr
-- |Retrieve the dependencies of a given module
moduleDeps :: Options -> [FilePath] -> SourceEnv -> FilePath -> Module -> IO SourceEnv
moduleDeps opts paths sEnv fn (Module m _ is _) = case Map.lookup m sEnv of
moduleDeps :: Options -> SourceEnv -> FilePath -> Module -> IO SourceEnv
moduleDeps opts sEnv fn (Module m _ is _) = case Map.lookup m sEnv of
Just _ -> return sEnv
Nothing -> do
let imps = imports opts m is
sEnv' = Map.insert m (Source fn imps) sEnv
foldM (moduleIdentDeps opts paths) sEnv' imps
foldM (moduleIdentDeps opts) sEnv' imps
-- |Retrieve the imported modules and add the import of the Prelude
-- according to the compiler options.
......@@ -111,23 +111,22 @@ imports opts m ds = nub $
where implicitPrelude = NoImplicitPrelude `notElem` optExtensions opts
-- |Retrieve the dependencies for a given 'ModuleIdent'
moduleIdentDeps :: Options -> [FilePath] -> SourceEnv -> ModuleIdent -> IO SourceEnv
moduleIdentDeps opts paths sEnv m = case Map.lookup m sEnv of
moduleIdentDeps :: Options -> SourceEnv -> ModuleIdent -> IO SourceEnv
moduleIdentDeps opts sEnv m = case Map.lookup m sEnv of
Just _ -> return sEnv
Nothing -> do
mFile <- lookupCurryModule paths libraryPaths m
mFile <- lookupCurryModule (optImportPaths opts) (optLibraryPaths opts) m
case mFile of
Nothing -> return $ Map.insert m Unknown sEnv
Just fn
| icurryExt `isSuffixOf` fn -> return $ Map.insert m (Interface fn) sEnv
| otherwise -> checkModuleHeader fn
where
libraryPaths = optImportPaths opts
checkModuleHeader fn = do
hdr@(Module m' _ _ _) <- patchModuleId fn `liftM` (ok . parseHeader fn)
`liftM` readFile fn
unless (m == m') $ error $ errWrongModule m m'
moduleDeps opts paths sEnv fn hdr
moduleDeps opts sEnv fn hdr
-- If we want to compile the program instead of generating Makefile
-- dependencies the environment has to be sorted topologically. Note
......
......@@ -89,7 +89,7 @@ genFullCurrySyntax check paths fn m = runMsgIO m $ \mod1 -> do
-- if they are not up-to-date.
makeInterfaces :: [FilePath] -> FilePath -> Module -> IO [String]
makeInterfaces paths fn mdl = do
(deps1, errs) <- fmap flattenDeps $ moduleDeps defaultOptions paths Map.empty fn mdl
(deps1, errs) <- fmap flattenDeps $ moduleDeps (mkOpts paths) Map.empty fn mdl
when (null errs) $ mapM_ (compile deps1 . snd) deps1
return errs
where
......
......@@ -15,11 +15,11 @@
module Main (main) where
import Base.Messages (putErrsLn, abortWith)
import Files.CymakePath (cymakeGreeting)
import Files.CymakePath (cymakeGreeting, cymakeVersion)
import Html.CurryHtml (source2html)
import CurryBuilder (buildCurry)
import CompilerOpts (Options (..), compilerOpts, usage)
import CompilerOpts (Options (..), CymakeMode (..), compilerOpts, usage)
-- |The command line tool cymake
main :: IO ()
......@@ -28,21 +28,27 @@ main = compilerOpts >>= cymake
-- |Invoke the curry builder w.r.t the command line arguments
cymake :: (String, Options, [String], [String]) -> IO ()
cymake (prog, opts, files, errs)
| optHelp opts = printUsage prog
| optVersion opts = printVersion
| null files = printUsage prog
| not $ null errs = badUsage prog errs
| optHtml opts = mapM_ (source2html opts) files
| otherwise = mapM_ (buildCurry opts) files
-- |Print the program greeting
printVersion :: IO ()
printVersion = putStrLn cymakeGreeting
| mode == ModeHelp = printUsage prog
| mode == ModeVersion = printVersion
| mode == ModeNumericVersion = printNumericVersion
| not $ null errs = badUsage prog errs
| null files = printUsage prog
| mode == ModeHtml = mapM_ (source2html opts) files
| otherwise = mapM_ (buildCurry opts) files
where mode = optMode opts
-- |Print the usage information of the command line tool
printUsage :: String -> IO ()
printUsage prog = putStrLn $ usage prog
-- |Print the program version
printVersion :: IO ()
printVersion = putStrLn cymakeGreeting
-- |Print the numeric program version
printNumericVersion :: IO ()
printNumericVersion = putStrLn cymakeVersion
-- |Print errors and abort execution on bad parameters
badUsage :: String -> [String] -> IO ()
badUsage prog errs = do
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment