[pass extensions,include-dirs,hs-source-dirs and options from the library description file properly through pipeline
John Meacham <john@repetae.net>**20120122022054
 Ignore-this: 1dd8175dbfebc9fac9aee51968762864
] hunk ./Makefile.am 56
-JHC_LIBS = jhc-1.0.hl base-1.0.hl haskell98-1.0.hl applicative-1.0.hl flat-foreign-1.0.hl # jhc-prim-0.7.0.hl
+JHC_LIBS = jhc-1.0.hl base-1.0.hl haskell98-1.0.hl applicative-1.0.hl flat-foreign-1.0.hl jhc-prim-1.0.hl
hunk ./Makefile.am 220
-jhc-prim-0.7.0.hl: lib/jhc-prim/jhc-prim.yaml
+jhc-prim-1.0.hl: lib/jhc-prim/jhc-prim.yaml lib/jhc-prim/Jhc/Prim.hs lib/jhc-prim/Jhc/Prim/IO.hs lib/jhc-prim/Jhc/Prim/Words.hs lib/jhc-prim/Jhc/Prim/Bits.hs
hunk ./lib/jhc-prim/Jhc/Prim/IO.hs 11
-
hunk ./lib/jhc-prim/jhc-prim.yaml 3
+Extensions: [ ForeignFunctionInterface, NoImplicitPrelude, UnboxedTuples, UnboxedValues ]
+Hs-Source-Dir: .
hunk ./src/Ho/Build.hs 11
+
hunk ./src/Ho/Build.hs 23
+import System.FilePath as FP
hunk ./src/Ho/Build.hs 25
-import System.Random (randomIO)
hunk ./src/Ho/Build.hs 151
-fetchSource :: IORef Done -> [FilePath] -> Maybe Module -> IO Module
-fetchSource _ [] _ = fail "No files to load"
-fetchSource done_ref fs mm = do
+fetchSource :: Opt -> IORef Done -> [FilePath] -> Maybe Module -> IO Module
+fetchSource _ _ [] _ = fail "No files to load"
+fetchSource modOpt done_ref fs mm = do
hunk ./src/Ho/Build.hs 165
-            (hmod,_) <- parseHsSource fn lbs
+            (hmod,_) <- parseHsSource modOpt  fn lbs
hunk ./src/Ho/Build.hs 186
-            mapM_ (resolveDeps done_ref) ds
+            mapM_ (resolveDeps modOpt done_ref) ds
hunk ./src/Ho/Build.hs 189
-resolveDeps :: IORef Done -> Module -> IO ()
-resolveDeps done_ref m = do
+resolveDeps :: Opt -> IORef Done -> Module -> IO ()
+resolveDeps modOpt done_ref m = do
hunk ./src/Ho/Build.hs 195
-        Nothing -> fetchSource done_ref (map fst $ searchPaths (show m)) (Just m) >> return ()
+        Nothing -> fetchSource modOpt done_ref (map fst $ searchPaths modOpt (show m)) (Just m) >> return ()
hunk ./src/Ho/Build.hs 386
-    :: [FilePath]                                           -- ^ Targets we are building, used when dumping dependencies
+    :: Opt                                                  -- ^ Options to use when parsing files
+    -> [FilePath]                                           -- ^ Targets we are building, used when dumping dependencies
hunk ./src/Ho/Build.hs 393
-parseFiles targets elibs need ifunc func = do
+parseFiles options targets elibs need ifunc func = do
hunk ./src/Ho/Build.hs 395
-    (ksm,chash,cug) <- loadModules targets (optHls options ++ elibs) need
+    (ksm,chash,cug) <- loadModules options targets (snub $ optHls options ++ elibs) need
hunk ./src/Ho/Build.hs 400
-    typeCheckGraph cnode
+    typeCheckGraph options cnode
hunk ./src/Ho/Build.hs 410
-    :: [FilePath]               -- ^ targets
+    :: Opt                      -- ^ Options to use when parsing files
+    -> [FilePath]               -- ^ targets
hunk ./src/Ho/Build.hs 415
-loadModules targets libs need = do
+loadModules modOpt targets libs need = do
hunk ./src/Ho/Build.hs 447
-        fetchSource done_ref [fn] Nothing
-    forM_ (lefts need) $ resolveDeps done_ref
+        fetchSource modOpt done_ref [fn] Nothing
+    forM_ (lefts need) $ resolveDeps modOpt done_ref
hunk ./src/Ho/Build.hs 503
-typeCheckGraph :: CompNode -> IO ()
-typeCheckGraph cn = do
+typeCheckGraph :: Opt -> CompNode -> IO ()
+typeCheckGraph modOpt cn = do
hunk ./src/Ho/Build.hs 530
-                                (mod,lbs') <- parseHsSource (sourceFP si) lbs
-                                case optAnnotate options of
+                                (mod,lbs') <- parseHsSource modOpt (sourceFP si) lbs
+                                case optAnnotate modOpt of
hunk ./src/Ho/Build.hs 624
-searchPaths :: String -> [(String,String)]
-searchPaths m = ans where
+searchPaths :: Opt -> String -> [(String,String)]
+searchPaths modOpt m = ans where
hunk ./src/Ho/Build.hs 628
-    ans = [ (root ++ suf,root ++ ".ho") | i <- optIncdirs options, n <- f m, suf <- [".hs",".lhs",".hsc"], let root = i ++ "/" ++ n]
+    ans = [ (root ++ suf,root ++ ".ho") | i <- optIncdirs modOpt, n <- f m, suf <- [".hs",".lhs",".hsc"], let root = i ++ "/" ++ n]
hunk ./src/Ho/Build.hs 650
-        (desc,name,vers,hmods,emods) <- parse fp
+        (desc,name,vers,hmods,emods, modOpts) <- parse fp
hunk ./src/Ho/Build.hs 655
-        let outName = case optOutName options of
+        let outName = case optOutName modOpts of
hunk ./src/Ho/Build.hs 659
-        (rnode@(CompNode lhash _ _),cho) <- parseFiles [outName] [] (map Left $ Set.toList allMods) ifunc func
+        (rnode@(CompNode lhash _ _),cho) <- parseFiles modOpts [outName] [] (map Left $ Set.toList allMods) ifunc func
hunk ./src/Ho/Build.hs 715
+        let (modOpts,flags) = (lproc bopt,modOptions) where
+                Just bopt = fileOptions options modOptions `mplus` Just options
+                (pfs,nfs,_) = languageFlags (mfield "extensions")
+                lproc opt = opt { optFOptsSet = Set.union pfs (optFOptsSet opt) Set.\\ nfs }
+                dirs = [ "-i" ++ (FP.takeDirectory fp FP.</> x) | x <- mfield "hs-source-dirs" ]
+                    ++ [ "-I" ++ (FP.takeDirectory fp FP.</> x) | x <- mfield "include-dirs" ]
+                modOptions =  (mfield "options" ++ dirs)
+        when verbose $
+            print (flags,optFOptsSet modOpts)
hunk ./src/Ho/Build.hs 726
-        return (Map.toList dsing,name,vers,hmods,emods)
+        return (Map.toList dsing,name,vers,hmods,emods, modOpts)
hunk ./src/Ho/ReadSource.hs 5
+   languageFlags,
hunk ./src/Ho/ReadSource.hs 11
-import Data.List
hunk ./src/Ho/ReadSource.hs 12
-import Foreign.C
hunk ./src/Ho/ReadSource.hs 15
-import System.Random (randomIO)
hunk ./src/Ho/ReadSource.hs 19
+import qualified Data.Map as Map
hunk ./src/Ho/ReadSource.hs 37
-preprocessHs :: FilePath -> LBS.ByteString -> IO LBS.ByteString
-preprocessHs fn lbs = preprocess (fst $ collectFileOpts fn (LBSU.toString $ LBS.take 2048 lbs)) fn lbs
+preprocessHs :: Opt -> FilePath -> LBS.ByteString -> IO LBS.ByteString
+preprocessHs options fn lbs = preprocess (fst $ collectFileOpts options fn (LBSU.toString $ LBS.take 2048 lbs)) fn lbs
hunk ./src/Ho/ReadSource.hs 43
-        incFlags = [ "-I" ++ d | d <- optIncdirs options ++ optIncs opt]
+        incFlags = [ "-I" ++ d | d <- optIncdirs opt ++ optIncs opt]
hunk ./src/Ho/ReadSource.hs 46
-        _ | fopts FO.Cpp -> readSystem "cpp" $ ["-CC","-traditional"] ++ incFlags ++ defFlags ++ [fn]
-          | fopts FO.M4 -> do
+        _ | FO.Cpp `Set.member` optFOptsSet opt -> readSystem "cpp" $ ["-CC","-traditional"] ++ incFlags ++ defFlags ++ [fn]
+          | FO.M4 `Set.member` optFOptsSet opt -> do
hunk ./src/Ho/ReadSource.hs 59
-collectFileOpts fn s = (opt,isJust fopts)  where
+collectFileOpts options fn s = (lproc opt,isJust fopts)  where
hunk ./src/Ho/ReadSource.hs 62
-    fopts = fileOptions opts
+    fopts = fileOptions options opts
hunk ./src/Ho/ReadSource.hs 64
-    opts' = concatMap words (copts ["OPTIONS","JHC_OPTIONS","OPTIONS_JHC"])
-    opts = opts' ++ [ "-fno-prelude" | ("NOPRELUDE",_) <- popts] ++ langs
-    langs = catMaybes $ map (`lookup` langmap) $ concatMap
-        (words . (map (\c -> if c == ',' then ' ' else toLower c)))
-        (copts ["LANGUAGE","JHC_LANGUAGE"] ++ optExtensions options ++ [ o | '-':'X':o <- opts'])
+    opts = concatMap words (copts ["OPTIONS","JHC_OPTIONS","OPTIONS_JHC"])
+    (pfs,nfs,_) = languageFlags $ concatMap (words . (map (\c -> if c == ',' then ' ' else c)))
+        (copts ["LANGUAGE","JHC_LANGUAGE"] ++ optExtensions options ++ [ o | '-':'X':o <- opts])
+    lproc opt = opt { optFOptsSet = Set.union pfs (optFOptsSet opt) Set.\\ nfs }
hunk ./src/Ho/ReadSource.hs 69
-langmap = [
-    "m4" ==> "m4",
-    "cpp" ==> "cpp",
-    "foreignfunctioninterface" ==> "ffi",
-    "noimplicitprelude" ==> "no-prelude",
-    "implicitprelude" ==> "prelude",
-    "unboxedtuples" ==> "unboxed-tuples",
-    "unboxedvalues" ==> "unboxed-values",
-    "monomorphismrestriction" ==> "monomorphism-restriction",
-    "nomonomorphismrestriction" ==> "no-monomorphism-restriction",
-    "magichash" ==> "unboxed-values"
-    ] where x ==> y = (x,"-f" ++ y) -- if head y == '-' then y else "-f" ++ y)
+-- translates a list of language extensions as pased to a LANGUAGE pragma or
+-- the -X option to the equivalent '-f' flags. The first return value are the
+-- positive flags, the negative flags, and the third is the unrecognized extensions.
+languageFlags :: [String] -> (Set.Set FO.Flag,Set.Set FO.Flag,[String])
+languageFlags ls = f ls Set.empty Set.empty [] where
+    f [] pfs nfs us = (pfs,nfs,us)
+    f (l:ls) pfs nfs us | Just lo <- Map.lookup ll langmap =  f ls (Set.insert lo pfs) nfs us
+                        | 'n':'o':ll <- ll, Just lo <- Map.lookup ll langmap = f ls pfs (Set.insert lo nfs) us
+                        | otherwise = f ls pfs nfs (l:us)
+        where ll = map toLower l
hunk ./src/Ho/ReadSource.hs 80
-parseHsSource :: FilePath -> LBS.ByteString -> IO (HsModule,LBS.ByteString)
-parseHsSource fp@(FP.splitExtension -> (base,".hsc")) _ = do
+
+langmap = Map.fromList [
+    "m4" ==> FO.M4,
+    "cpp" ==> FO.Cpp,
+    "foreignfunctioninterface" ==> FO.Ffi,
+    "implicitprelude" ==> FO.Prelude,
+    "unboxedtuples" ==> FO.UnboxedTuples,
+    "unboxedvalues" ==> FO.UnboxedValues,
+    "monomorphismrestriction" ==> FO.MonomorphismRestriction,
+    "magichash" ==> FO.UnboxedValues
+    ] where x ==> y = (x,y)
+
+parseHsSource :: Opt -> FilePath -> LBS.ByteString -> IO (HsModule,LBS.ByteString)
+parseHsSource options fp@(FP.splitExtension -> (base,".hsc")) _ = do
hunk ./src/Ho/ReadSource.hs 104
-    parseHsSource out lbs
-
-parseHsSource fn lbs = do
-    lbs' <- preprocessHs fn lbs
+    parseHsSource options out lbs
+parseHsSource options fn lbs = do
+    lbs' <- preprocessHs options fn lbs
hunk ./src/Ho/ReadSource.hs 117
-    let (fileOpts',ogood) = collectFileOpts fn s
+    let (fileOpts',ogood) = collectFileOpts options fn s
hunk ./src/Main.hs 42
-            res <- preprocessHs fn lbs
+            res <- preprocessHs options fn lbs
hunk ./src/Main.hs 56
-    g fs = processCollectedHo . snd =<< parseFiles [outputName] [] fs processInitialHo processDecls
+    g fs = processCollectedHo . snd =<< parseFiles options [outputName] [] fs processInitialHo processDecls
hunk ./src/Options.hs 283
-        (s,[]) -> return $ o { optDumpSet = s }
+        (s,[]) -> return $ o { optDumpSet = s, optDump = [] }
hunk ./src/Options.hs 293
-        (s,[]) -> return $ o { optFOptsSet = s }
+        (s,[]) -> return $ o { optFOptsSet = s, optFOpts = [] }
hunk ./src/Options.hs 398
-fileOptions :: Monad m => [String] -> m Opt
-fileOptions xs = case getOpt Permute theoptions xs of
+fileOptions :: Monad m => Opt -> [String] -> m Opt
+fileOptions options xs = case getOpt Permute theoptions xs of