Commit c8efef5d authored by ijones's avatar ijones
Browse files

preprocessing code, some from hmake

These are some of the changes to HMake that Malcolm and I had
talked about some time back.  The PPSuffixHandler is meant to
allow extendability.  Build will probably have to take a list
of these as an argument.
parent 1167e1ca
......@@ -39,21 +39,89 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module Distribution.PreProcess (preprocessSources) where
import Distribution.PreProcess.Unlit(plain, unlit)
import Distribution.Package (PackageDescription(..), BuildInfo(..), Executable(..))
import Distribution.Simple.Configure (LocalBuildInfo(..))
import Distribution.Simple.Utils (setupMessage,moveSources, pathJoin, withLib)
import Distribution.Setup (CompilerFlavor(..))
-- |Copy and (possibly) preprocess sources from hsSourceDirs
preprocessSources :: PackageDescription
-> LocalBuildInfo
-> FilePath -- ^ Directory to put preprocessed
-- sources in
-> [PPSuffixHandler] -- ^ preprocessors to try
-> FilePath {- ^ Directory to put preprocessed
sources in -}
-> IO ()
preprocessSources pkg_descr _ pref =
preprocessSources pkg_descr _ _ pref =
do
setupMessage "Preprocessing" pkg_descr
withLib pkg_descr $ \lib ->
moveSources (hsSourceDir lib) (pathJoin [pref, hsSourceDir lib]) (modules lib) ["hs","lhs"]
sequence_ [ moveSources (hsSourceDir exeBi) (pathJoin [pref, hsSourceDir exeBi]) (modules exeBi) ["hs","lhs"]
| Executable _ _ exeBi <- executables pkg_descr]
data PreProcessor = PreProcessor
{ ppExecutableName :: String,
ppDefaultOptions :: [String]
-- |How to construct the output option
ppOutputFileOption :: FilePath -> String,
-- |Whether the pp produces source appropriate for this compiler.
ppSuitable :: CompilerFlavor -> Bool,
}
| PreProcessAction (FilePath -> IO ())
type PPSuffixHandler
= (String, (String->String->String), PreProcessor)
-- |Leave in unlit since some preprocessors can't handle literated
-- source?
knownSuffixes :: [ PPSuffixHandler ]
knownSuffixes =
[ ("gc", plain, ppGreenCard)
, ("chs", plain, ppC2hs)
, ("hsc", plain, ppHsc2hs)
, ("y", plain, ppHappy)
, ("ly", unlit, ppHappy)
-- , ("hs.cpp", plain, ppCpp)
, ("gc", plain, ppNone) -- note, for nhc98 only
, ("hs", plain, ppNone)
-- , ("lhs", unlit, ppNone)
]
ppGreenCard, ppHsc2hs, ppC2hs, ppHappy, ppNone :: PreProcessor
-- ppCpp = PreProcessor
-- { ppExecutableName = "gcc -E -traditional"
-- , ppDefaultOptions = \d-> "-x c" : map ("-D"++) (defs d++zdefs d)
-- , ppOutputFileOption = \f-> "> "++f
-- , ppSuitable = \hc-> True
-- }
ppGreenCard = PreProcessor
{ ppExecutableName = "green-card"
, ppDefaultOptions = ["-tffi"] -- + includePath of compiler?
, ppOutputFileOption = \f-> "-o "++f
, ppSuitable = \hc-> hc == GHC
}
ppHsc2hs = PreProcessor
{ ppExecutableName = "hsc2hs"
, ppDefaultOptions = []
, ppOutputFileOption = \_-> ""
, ppSuitable = \hc-> hc `elem` [GHC,NHC]
}
ppC2hs = PreProcessor
{ ppExecutableName = "c2hs"
, ppDefaultOptions = []
, ppOutputFileOption = \_-> ""
, ppSuitable = \hc-> hc `elem` [GHC,NHC]
}
ppHappy = PreProcessor
{ ppExecutableName = "happy"
, ppDefaultOptions = []
, ppOutputFileOption = \_-> ""
, ppSuitable = \hc-> True
}
ppNone = PreProcessor
{ ppExecutableName = ""
, ppDefaultOptions = []
, ppOutputFileOption = \_-> ""
, ppSuitable = \hc-> True
}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.PreProcess.Unlit
-- Copyright : ...
--
-- Maintainer : Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
-- Stability : Stable
-- Portability : All
--
-- Remove the "literal" markups from a Haskell source file, including
-- ">", "\begin{code}, \end{code}", and "#"
--
-- Part of the following code is from
-- "Report on the Programming Language Haskell",
-- version 1.2, appendix C.
module Distribution.PreProcess.Unlit(unlit,plain) where
import Char
-- exports:
unlit :: String -> String -> String
unlit file lhs = (unlines . map unclassify . adjacent file (0::Int) Blank
. classify 0) (tolines lhs)
plain :: String -> String -> String -- no unliteration
plain _ hs = hs
----
data Classified = Program String | Blank | Comment
| Include Int String | Pre String
classify :: Int -> [String] -> [Classified]
classify _ [] = []
classify _ (('\\':x):xs) | x == "begin{code}" = Blank : allProg xs
where allProg [] = [] -- Should give an error message, but I have no
-- good position information.
allProg (('\\':x):xs) | x == "end{code}" = Blank : classify 0 xs
allProg (x:xs) = Program x:allProg xs
classify 0 (('>':x):xs) = let (sp,code) = span isSpace x in
Program code : classify (length sp + 1) xs
classify n (('>':x):xs) = Program (drop (n-1) x) : classify n xs
classify _ (('#':x):xs) =
(case words x of
(line:file:_) | all isDigit line -> Include (read line) file
_ -> Pre x
) : classify 0 xs
classify _ (x:xs) | all isSpace x = Blank:classify 0 xs
classify _ (x:xs) = Comment:classify 0 xs
unclassify :: Classified -> String
unclassify (Program s) = s
unclassify (Pre s) = '#':s
unclassify (Include i f) = '#':' ':show i ++ ' ':f
unclassify Blank = ""
unclassify Comment = ""
adjacent :: String -> Int -> Classified -> [Classified] -> [Classified]
adjacent file 0 _ (x :xs) = x: adjacent file 1 x xs
-- force evaluation of line number
adjacent file n y@(Program _) (x@Comment :xs) =
error (message file n "program" "comment")
adjacent file n y@(Program _) (x@(Include i f):xs) = x: adjacent f i y xs
adjacent file n y@(Program _) (x@(Pre _) :xs) = x: adjacent file (n+1) y xs
adjacent file n y@Comment (x@(Program _) :xs) =
error (message file n "comment" "program")
adjacent file n y@Comment (x@(Include i f):xs) = x: adjacent f i y xs
adjacent file n y@Comment (x@(Pre _) :xs) = x: adjacent file (n+1) y xs
adjacent file n y@Blank (x@(Include i f):xs) = x: adjacent f i y xs
adjacent file n y@Blank (x@(Pre _) :xs) = x: adjacent file (n+1) y xs
adjacent file n _ (x@next :xs) = x: adjacent file (n+1) x xs
adjacent file n _ [] = []
message "\"\"" n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"
message [] n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"
message file n p c = "In file " ++ file ++ " at line "
++show n++": "++p++ " line before "++c++" line.\n"
-- Re-implementation of 'lines', for better efficiency (but decreased
-- laziness). Also, importantly, accepts non-standard DOS and Mac line
-- ending characters.
tolines s = lines' s id
where
lines' [] acc = [acc []]
lines' ('\^M':'\n':s) acc = acc [] : lines' s id -- DOS
lines' ('\^M':s) acc = acc [] : lines' s id -- MacOS
lines' ('\n':s) acc = acc [] : lines' s id -- Unix
lines' (c:s) acc = lines' s (acc . (c:))
{-
-- A very naive version of unliteration....
module Unlit(unlit) where
-- This version does not handle \begin{code} & \end{code}, and it is
-- careless with indentation.
unlit = map unlitline
unlitline ('>' : s) = s
unlitline _ = ""
-}
* 0.2
** add simple (cpphs) preprocessing?
** Preprocessing
- add simple (cpphs) preprocessing?
- what other preprocessors can't unlit?
-
** clarify description filename issues
- allow foo.hsproj?
......
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