Commit 7d5811fa authored by Björn Peemöller 's avatar Björn Peemöller

Added ability to consider options specified in an OPTIONS pragma

parent 76a04c65
......@@ -4,6 +4,30 @@ Change log for curry-frontend
Version 0.3.10
==============
* The frontend now considers options pragmas of the following form:
~~~ {.curry}
{-# OPTIONS_CYMAKE opt1 ... optn #-}
~~~
The string following `OPTIONS_CYMAKE` will be split at white spaces
and treated like an ordinary command line argument string.
If one wishes to provide options containing spaces, e.g., directory
paths or alike, this can be achieved by quoting the respective argument
using either `'single quotes'` or `'double quotes'` (may bot be mixed).
Note that *following options are excluded*:
* A change of the current mode
(e.g., change from compilation to HTML generation)
* A change of the import paths
* A change of the library paths
* A change of the compilation targets
(e.g., change from FlatCurry to AbstractCurry)
These options can only be set via the command line.
* Refactored the source code HTML generation.
The generation now supports full Curry with all supported extensions,
i.e., it supports pragmas, record types and functional patterns.
......
......@@ -3,7 +3,7 @@
Description : Compiler options
Copyright : (c) 2005 Martin Engelke
2007 Sebastian Fischer
2011 - 2013 Björn Peemöller
2011 - 2014 Björn Peemöller
License : OtherLicense
Maintainer : bjp@informatik.uni-kiel.de
......@@ -19,7 +19,7 @@ module CompilerOpts
, CymakeMode (..), Verbosity (..), TargetType (..)
, WarnFlag (..), KnownExtension (..), DumpLevel (..), dumpLevel
, defaultOptions, defaultPrepOpts, defaultWarnOpts, defaultDebugOpts
, getCompilerOpts, usage
, getCompilerOpts, updateOpts, usage
) where
import Data.List (intercalate, nub)
......@@ -444,13 +444,16 @@ addFlag o opts = nub $ o : opts
removeFlag :: Eq a => a -> [a] -> [a]
removeFlag o opts = filter (/= o) opts
-- |Parse the command line arguments
parseOpts :: [String] -> (Options, [String], [String])
parseOpts args = (opts, files, errs ++ errs2 ++ checkOpts opts files)
updateOpts :: Options -> [String] -> (Options, [String], [String])
updateOpts opts args = (opts', files, errs ++ errs2 ++ checkOpts opts files)
where
(opts, errs2) = foldl (flip ($)) (defaultOptions, []) optErrs
(opts', errs2) = foldl (flip ($)) (opts, []) optErrs
(optErrs, files, errs) = getOpt Permute options args
-- |Parse the command line arguments
parseOpts :: [String] -> (Options, [String], [String])
parseOpts = updateOpts defaultOptions
-- |Check options and files and return a list of error messages
checkOpts :: Options -> [String] -> [String]
checkOpts opts _
......
......@@ -15,19 +15,22 @@
-}
module CurryBuilder (buildCurry) where
import Control.Monad (liftM)
import Control.Monad (foldM, liftM)
import Data.Char (isSpace)
import Data.Maybe (catMaybes, mapMaybe)
import System.FilePath (normalise)
import Curry.Base.Ident
import Curry.Base.Position (Position)
import Curry.Base.Pretty
import Curry.Files.Filenames
import Curry.Files.PathUtils
import Curry.Syntax (ModulePragma (..), Tool (CYMAKE))
import Base.Messages
import CompilerOpts ( Options (..), DebugOpts (..), TargetType (..)
, defaultDebugOpts)
, defaultDebugOpts, updateOpts)
import CurryDeps (Source (..), flatDeps)
import Modules (compileModule)
......@@ -78,25 +81,66 @@ makeCurry opts srcs = mapM_ process' (zip [1 ..] srcs)
total = length srcs
process' :: (Int, (ModuleIdent, Source)) -> CYIO ()
process' (n, (m, Source fn is)) = process opts' (n, total) m fn deps
process' (n, (m, Source fn ps is)) = do
opts' <- processPragmas opts ps
process (adjustOptions (n == total) opts') (n, total) m fn deps
where
opts' | n == total = opts { optForce = optForce opts || isDump }
| otherwise = opts { optTargetTypes = [flatTarget]
, optForce = False
, optDebugOpts = defaultDebugOpts
}
isDump = not $ null $ dbDumpLevels $ optDebugOpts opts
flatTarget = if ExtendedFlatCurry `elem` optTargetTypes opts
then ExtendedFlatCurry else FlatCurry
deps = fn : mapMaybe curryInterface is
curryInterface i = case lookup i srcs of
Just (Source fn' _) -> Just $ interfName fn'
Just (Interface fn') -> Just $ interfName fn'
_ -> Nothing
Just (Source fn' _ _) -> Just $ interfName fn'
Just (Interface fn' ) -> Just $ interfName fn'
_ -> Nothing
process' _ = return ()
adjustOptions :: Bool -> Options -> Options
adjustOptions final opts
| final = opts { optForce = optForce opts || isDump }
| otherwise = opts { optTargetTypes = [flatTarget]
, optForce = False
, optDebugOpts = defaultDebugOpts
}
where
isDump = not $ null $ dbDumpLevels $ optDebugOpts opts
flatTarget = if ExtendedFlatCurry `elem` optTargetTypes opts
then ExtendedFlatCurry else FlatCurry
processPragmas :: Options -> [ModulePragma] -> CYIO Options
processPragmas opts0 ps = foldM processPragma opts0
[ (p, s) | OptionsPragma p (Just CYMAKE) s <- ps ]
where
processPragma opts (p, s)
| not (null unknownFlags)
= left [errUnknownOptions p unknownFlags]
| optMode opts /= optMode opts'
= left [errIllegalOption p "Cannot change mode"]
| optLibraryPaths opts /= optLibraryPaths opts'
= left [errIllegalOption p "Cannot change library path"]
| optImportPaths opts /= optImportPaths opts'
= left [errIllegalOption p "Cannot change import path"]
| optTargetTypes opts /= optTargetTypes opts'
= left [errIllegalOption p "Cannot change target type"]
| otherwise
= return opts'
where
(opts', files, errs) = updateOpts opts (quotedWords s)
unknownFlags = files ++ errs
quotedWords :: String -> [String]
quotedWords str = case dropWhile isSpace str of
[] -> []
s@('\'' : cs) -> case break (== '\'') cs of
(_ , [] ) -> def s
(quoted, (_:rest)) -> quoted : quotedWords rest
s@('"' : cs) -> case break (== '"') cs of
(_ , [] ) -> def s
(quoted, (_:rest)) -> quoted : quotedWords rest
s -> def s
where
def s = let (w, rest) = break isSpace s in w : quotedWords rest
-- |Compile a single source module.
process :: Options -> (Int, Int)
-> ModuleIdent -> FilePath -> [FilePath] -> CYIO ()
......@@ -156,6 +200,15 @@ cancelMissing act f = liftIO (act f) >>= \res -> case res of
Nothing -> left [errModificationTime f]
Just val -> right val
errUnknownOptions :: Position -> [String] -> Message
errUnknownOptions p errs = posMessage p $
text "Unknown flag(s) in {-# OPTIONS_CYMAKE #-} pragma:"
<+> sep (punctuate comma $ map text errs)
errIllegalOption :: Position -> String -> Message
errIllegalOption p err = posMessage p $
text "Illegal option in {-# OPTIONS_CYMAKE #-} pragma:" <+> text err
errMissing :: String -> String -> Message
errMissing what which = message $ sep $ map text
[ "Missing", what, quote which ]
......
......@@ -29,7 +29,7 @@ import Curry.Base.Pretty
import Curry.Files.Filenames
import Curry.Files.PathUtils
import Curry.Syntax
( Module (..), ImportDecl (..), parseHeader, patchModuleId
( Module (..), ModulePragma (..), ImportDecl (..), parseHeader, patchModuleId
, hasLanguageExtension)
import Base.Messages
......@@ -38,10 +38,13 @@ import CompilerOpts (Options (..), KnownExtension (..))
-- |Different types of source files
data Source
= Source FilePath [ModuleIdent] -- ^ A source file with module imports
| Interface FilePath -- ^ An interface file
| Unknown -- ^ An unkonwn file
deriving (Eq, Ord, Show)
-- ^ A source file with pragmas and module imports
= Source FilePath [ModulePragma] [ModuleIdent]
-- ^ An interface file
| Interface FilePath
-- ^ An unkonwn file
| Unknown
deriving (Eq, Show)
type SourceEnv = Map.Map ModuleIdent Source
......@@ -91,11 +94,11 @@ sourceDeps opts sEnv fn = readHeader fn >>= moduleDeps opts sEnv fn
-- |Retrieve the dependencies of a given module
moduleDeps :: Options -> SourceEnv -> FilePath -> Module -> CYIO SourceEnv
moduleDeps opts sEnv fn mdl@(Module _ m _ _ _) = case Map.lookup m sEnv of
moduleDeps opts sEnv fn mdl@(Module ps m _ _ _) = case Map.lookup m sEnv of
Just _ -> return sEnv
Nothing -> do
let imps = imports opts mdl
sEnv' = Map.insert m (Source fn imps) sEnv
sEnv' = Map.insert m (Source fn ps imps) sEnv
foldM (moduleIdentDeps opts) sEnv' imps
-- |Retrieve the imported modules and add the import of the Prelude
......@@ -145,8 +148,8 @@ flattenDeps = fdeps . sortDeps
idents (m, _) = [m]
imported (_, Source _ ms) = ms
imported (_, _) = []
imported (_, Source _ _ ms) = ms
imported (_, _) = []
fdeps :: [[(ModuleIdent, Source)]] -> ([(ModuleIdent, Source)], [Message])
fdeps = foldr checkdep ([], [])
......
{-# OPTIONS_CYMAKE -e -ddump-all #-}
module OptionsCymake where
type F = { f :: Bool }
\ No newline at end of file
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