[move source code reading into its own module
John Meacham <john@repetae.net>**20120120060548
 Ignore-this: 65642eda6f6112e0f728f8def40858c7
] addfile ./src/Ho/ReadSource.hs
hunk ./Makefile.am 30
-	src/Name/Prim.hs src/PackedString.hs src/PrimitiveOperators.hs \
+	src/Name/Prim.hs src/PackedString.hs src/PrimitiveOperators.hs src/Ho/ReadSource.hs \
hunk ./src/Ho/Build.hs 16
+import Data.Maybe
hunk ./src/Ho/Build.hs 21
-import Maybe
hunk ./src/Ho/Build.hs 48
-import FrontEnd.Syn.Options
hunk ./src/Ho/Build.hs 53
+import Ho.ReadSource
hunk ./src/Ho/Build.hs 625
-    ans = [ (root ++ suf,root ++ ".ho") | i <- optIncdirs options, n <- f m, suf <- [".hs",".lhs"], let root = i ++ "/" ++ n]
-
-langmap = [
-    "m4" ==> "m4",
-    "cpp" ==> "cpp",
-    "foreignfunctioninterface" ==> "ffi",
-    "noimplicitprelude" ==> "--noprelude",
-    "unboxedtuples" ==> "unboxed-tuples"
-    ] where x ==> y = (x,if head y == '-' then y else "-f" ++ y)
-
-collectFileOpts fn s = opt where
-    Just opt = fileOptions opts `mplus` Just options
-    popts = parseOptions $ if "shl." `isPrefixOf` reverse fn  then unlit fn s else s
-    opts' = concat [ words as | (x,as) <- popts, x `elem` ["OPTIONS","JHC_OPTIONS","OPTIONS_JHC"]]
-    opts = opts' ++ [ "--noprelude" | ("NOPRELUDE",_) <- popts] ++ langs
-    langs = catMaybes $ map (flip lookup langmap) $ concat [ words (map (\c -> if c == ',' then ' ' else toLower c) as) | ("LANGUAGE",as) <- popts ]
-
-preprocessHs :: FilePath -> LBS.ByteString -> IO LBS.ByteString
-preprocessHs fn lbs = preprocess (collectFileOpts fn (LBSU.toString $ LBS.take 2048 lbs)) fn lbs
-
-parseHsSource :: String -> LBS.ByteString -> IO (HsModule,LBS.ByteString)
-parseHsSource fn lbs = do
-    let fileOpts = collectFileOpts fn (LBSU.toString $ LBS.take 2048 lbs)
-    lbs' <- preprocess fileOpts fn lbs
-    let s = LBSU.toString lbs'
-    let s' = if "shl." `isPrefixOf` reverse fn  then unlit fn s'' else s''
-        s'' = case s of
-            '#':' ':_   -> '\n':s                --  line pragma
-            '#':'l':'i':'n':'e':' ':_  -> '\n':s --  line pragma
-            '#':'!':_ -> dropWhile (/= '\n') s   --  hashbang
-            _ -> s
-    wdump FD.Preprocessed $ do
-        putStrLn s'
-    fn <- shortenPath fn
-    case runParserWithMode (parseModeOptions $ collectFileOpts fn s) { parseFilename = fn } parse  s'  of
-                      (ws,ParseOk e) -> processErrors ws >> return (e,LBSU.fromString s')
-                      (_,ParseFailed sl err) -> putErrDie $ show sl ++ ": " ++ err
+    ans = [ (root ++ suf,root ++ ".ho") | i <- optIncdirs options, n <- f m, suf <- [".hs",".lhs",".hsc"], let root = i ++ "/" ++ n]
hunk ./src/Ho/Library.hs 24
-import System.Random (randomIO)
hunk ./src/Ho/Library.hs 32
+import Ho.ReadSource
hunk ./src/Ho/Library.hs 37
-import RawFiles(prelude_m4)
-import Support.Yaml
-import Util.FilterInput
-import Util.Gen hiding(intercalate)
+import Util.Gen
hunk ./src/Ho/Library.hs 39
-import Version.Config(revision,version)
hunk ./src/Ho/Library.hs 214
+    f (_:xs) dlm dsm = f xs dlm dsm
hunk ./src/Ho/Library.hs 217
-ypath' :: FromNode r => String -> YamlNode -> r
-ypath' s n = case ypath s n of
-    Nothing -> error $ "Ypath lookup failed: " ++ s
-    Just n -> n
-
hunk ./src/Ho/Library.hs 262
-
-preprocess :: Opt -> FilePath -> LBS.ByteString -> IO LBS.ByteString
-preprocess opt fn lbs = do
-    let fopts s = s `Set.member` optFOptsSet opt
-        incFlags = [ "-I" ++ d | d <- optIncdirs options ++ optIncs opt]
-        defFlags = ("-D__JHC__=" ++ revision):("-D__JHC_VERSION__=" ++ version):[ "-D" ++ d | d <- optDefs opt]
-    case () of
-        _ | fopts FO.Cpp -> readSystem "cpp" $ ["-CC","-traditional"] ++ incFlags ++ defFlags ++ [fn]
-          | fopts FO.M4 -> do
-            m4p <- m4Prelude
-            result <- readSystem "m4" $ ["-s", "-P"] ++ incFlags ++ defFlags ++ [m4p,fn]
-            removeFile m4p >> return result
-          | otherwise -> return lbs
-
-m4Prelude :: IO FilePath
-m4Prelude = (randomIO :: IO Integer) >>= \salt ->
-    let m4p_filename = "/tmp/jhc_prelude-" ++ show salt ++ ".m4"
-    in BS.writeFile m4p_filename prelude_m4 >> return m4p_filename
hunk ./src/Ho/ReadSource.hs 1
+-- routines dealing with reading and preprocessing source code files.
+
+module Ho.ReadSource(
+   preprocess,
+   preprocessHs,
+   parseHsSource
+) where
+
+import Control.Monad
+import Data.Char
+import Data.List
+import Data.Maybe
+import System.Directory
+import System.Random (randomIO)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Lazy.UTF8 as LBSU
+import qualified Data.Set as Set
+import qualified System.FilePath as FP
+
+import FrontEnd.HsParser
+import FrontEnd.HsSyn
+import FrontEnd.ParseMonad
+import FrontEnd.Syn.Options
+import FrontEnd.Unlit
+import FrontEnd.Warning
+import Options
+import RawFiles(prelude_m4)
+import Util.FilterInput
+import Util.Gen
+import Version.Config(revision,version)
+import qualified FlagDump as FD
+import qualified FlagOpts as FO
+
+preprocessHs :: FilePath -> LBS.ByteString -> IO LBS.ByteString
+preprocessHs fn lbs = preprocess (collectFileOpts fn (LBSU.toString $ LBS.take 2048 lbs)) fn lbs
+
+preprocess :: Opt -> FilePath -> LBS.ByteString -> IO LBS.ByteString
+preprocess opt fn lbs = do
+    let fopts s = s `Set.member` optFOptsSet opt
+        incFlags = [ "-I" ++ d | d <- optIncdirs options ++ optIncs opt]
+        defFlags = ("-D__JHC__=" ++ revision):("-D__JHC_VERSION__=" ++ version):[ "-D" ++ d | d <- optDefs opt]
+    case () of
+        _ | fopts FO.Cpp -> readSystem "cpp" $ ["-CC","-traditional"] ++ incFlags ++ defFlags ++ [fn]
+          | fopts FO.M4 -> do
+            m4p <- m4Prelude
+            result <- readSystem "m4" $ ["-s", "-P"] ++ incFlags ++ defFlags ++ [m4p,fn]
+            removeFile m4p >> return result
+          | otherwise -> return lbs
+
+m4Prelude :: IO FilePath
+m4Prelude = (randomIO :: IO Integer) >>= \salt ->
+    let m4p_filename = "/tmp/jhc_prelude-" ++ show salt ++ ".m4"
+    in BS.writeFile m4p_filename prelude_m4 >> return m4p_filename
+
+collectFileOpts fn s = opt where
+    Just opt = fileOptions opts `mplus` Just options
+    popts = parseOptions $ if FP.takeExtension fn == ".lhs" then unlit fn s else s
+    opts' = concat [ words as | (x,as) <- popts, x `elem` ["OPTIONS","JHC_OPTIONS","OPTIONS_JHC"]]
+    opts = opts' ++ [ "--noprelude" | ("NOPRELUDE",_) <- popts] ++ langs
+    langs = catMaybes $ map (flip lookup langmap) $ concat [ words (map (\c -> if c == ',' then ' ' else toLower c) as) | ("LANGUAGE",as) <- popts ]
+
+langmap = [
+    "m4" ==> "m4",
+    "cpp" ==> "cpp",
+    "foreignfunctioninterface" ==> "ffi",
+    "noimplicitprelude" ==> "--noprelude",
+    "unboxedtuples" ==> "unboxed-tuples"
+    ] where x ==> y = (x,if head y == '-' then y else "-f" ++ y)
+
+parseHsSource :: FilePath -> LBS.ByteString -> IO (HsModule,LBS.ByteString)
+parseHsSource fn lbs = do
+    let fileOpts = collectFileOpts fn (LBSU.toString $ LBS.take 2048 lbs)
+    lbs' <- preprocess fileOpts fn lbs
+    let s = LBSU.toString lbs'
+    let s' = if "shl." `isPrefixOf` reverse fn  then unlit fn s'' else s''
+        s'' = case s of
+            '#':' ':_   -> '\n':s                --  line pragma
+            '#':'l':'i':'n':'e':' ':_  -> '\n':s --  line pragma
+            '#':'!':_ -> dropWhile (/= '\n') s   --  hashbang
+            _ -> s
+    wdump FD.Preprocessed $ do
+        putStrLn s'
+    fn <- shortenPath fn
+    case runParserWithMode (parseModeOptions $ collectFileOpts fn s) { parseFilename = fn } parse  s'  of
+                      (ws,ParseOk e) -> processErrors ws >> return (e,LBSU.fromString s')
+                      (_,ParseFailed sl err) -> putErrDie $ show sl ++ ": " ++ err