X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverUtil.hs;h=69173aafec66a863e6b059f46c2d02f1229a0261;hb=4ba55934c50379cba5650ddd84d9326a55722047;hp=75cda59078755ecc00c5431651b318239c2691d8;hpb=9a21989262b424b9c61d18fa8364fcd122b115d3;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/DriverUtil.hs b/ghc/compiler/main/DriverUtil.hs
index 75cda59..69173aa 100644
--- a/ghc/compiler/main/DriverUtil.hs
+++ b/ghc/compiler/main/DriverUtil.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverUtil.hs,v 1.1 2000/10/11 11:54:58 simonmar Exp $
+-- $Id: DriverUtil.hs,v 1.2 2000/10/11 14:08:52 simonmar Exp $
 --
 -- Utils for the driver
 --
@@ -17,6 +17,7 @@ import Util
 import IOExts
 import Exception
 import Dynamic
+import RegexString
 
 import IO
 import System
@@ -30,9 +31,10 @@ import Monad
 
 short_usage = "Usage: For basic information, try the `--help' option."
    
+GLOBAL_VAR(path_usage,  "",  String)
+
 long_usage = do
-  let usage_file = "ghc-usage.txt"
-      usage_path = findFile usage_file (cGHC_DRIVER_DIR ++ '/':usage_file)
+  usage_path <- readIORef path_usage
   usage <- readFile usage_path
   dump usage
   exitWith ExitSuccess
@@ -70,28 +72,27 @@ instance Typeable BarfKind where
   typeOf _ = mkAppTy barfKindTc []
 
 -----------------------------------------------------------------------------
--- Finding files in the installation
-
-GLOBAL_VAR(topDir, clibdir, String)
-
-	-- grab the last -B option on the command line, and
-	-- set topDir to its value.
-setTopDir :: [String] -> IO [String]
-setTopDir args = do
-  let (minusbs, others) = partition (prefixMatch "-B") args
-  (case minusbs of
-    []   -> writeIORef topDir clibdir
-    some -> writeIORef topDir (drop 2 (last some)))
-  return others
-
-findFile name alt_path = unsafePerformIO (do
-  top_dir <- readIORef topDir
-  let installed_file = top_dir ++ '/':name
-  let inplace_file   = top_dir ++ '/':cCURRENT_DIR ++ '/':alt_path
-  b <- doesFileExist inplace_file
-  if b  then return inplace_file
-	else return installed_file
- )
+-- Reading OPTIONS pragmas
+
+getOptionsFromSource 
+	:: String		-- input file
+	-> IO [String]		-- options, if any
+getOptionsFromSource file
+  = do h <- openFile file ReadMode
+       catchJust ioErrors (look h)
+	  (\e -> if isEOFError e then return [] else ioError e)
+  where
+	look h = do
+	    l <- hGetLine h
+	    case () of
+		() | null l -> look h
+		   | prefixMatch "#" l -> look h
+		   | prefixMatch "{-# LINE" l -> look h   -- -}
+		   | Just (opts:_) <- matchRegex optionRegex l
+			-> return (words opts)
+		   | otherwise -> return []
+
+optionRegex = mkRegex "\\{-#[ \t]+OPTIONS[ \t]+(.*)#-\\}"   -- -}
 
 -----------------------------------------------------------------------------
 -- Utils
@@ -111,15 +112,6 @@ my_prefix_match (p:pat) (r:rest)
   | p == r    = my_prefix_match pat rest
   | otherwise = Nothing
 
-prefixMatch :: Eq a => [a] -> [a] -> Bool
-prefixMatch [] _str = True
-prefixMatch _pat [] = False
-prefixMatch (p:ps) (s:ss) | p == s    = prefixMatch ps ss
-			  | otherwise = False
-
-postfixMatch :: String -> String -> Bool
-postfixMatch pat str = prefixMatch (reverse pat) (reverse str)
-
 later = flip finally
 
 handleDyn :: Typeable ex => (ex -> IO a) -> IO a -> IO a