[project @ 2002-05-01 09:30:04 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / ParsePkgConf.y
index 1a8f9db..995d300 100644 (file)
@@ -1,12 +1,17 @@
 {
-module ParsePkgConf (parsePkgConf) where
-import CmStaticInfo
+module ParsePkgConf( loadPackageConfig ) where
+
+import Packages  ( PackageConfig(..), defaultPackageConfig )
 import Lex
 import FastString
 import StringBuffer
 import SrcLoc
 import Outputable
+import Panic     ( GhcException(..) )
+import Exception ( throwDyn )
+
 #include "HsVersions.h"
+
 }
 
 %token
@@ -42,8 +47,9 @@ fields  :: { PackageConfig -> PackageConfig }
 
 field  :: { PackageConfig -> PackageConfig }
        : VARID '=' STRING              
-               {\p -> case unpackFS $1 of
-                       "name" -> p{name = unpackFS $3} }
+                 {% case unpackFS $1 of { 
+                  "name" -> returnP (\ p -> p{name = unpackFS $3});
+                  _      -> happyError } }
                        
        | VARID '=' strlist             
                {\p -> case unpackFS $1 of
@@ -72,17 +78,18 @@ strs        :: { [String] }
 happyError :: P a
 happyError buf PState{ loc = loc } = PFailed (srcParseErr buf loc)
 
-parsePkgConf :: FilePath -> IO (Either SDoc [PackageConfig])
-parsePkgConf conf_filename = do
-   buf <- hGetStringBuffer False conf_filename
-   case parse buf PState{ bol = 0#, atbol = 1#,
-                         context = [], glasgow_exts = 0#,
-                         loc = mkSrcLoc (_PK_ conf_filename) 1 } of
+loadPackageConfig :: FilePath -> IO [PackageConfig]
+loadPackageConfig conf_filename = do
+   buf <- hGetStringBuffer conf_filename
+   let loc  = mkSrcLoc (mkFastString conf_filename) 1
+       exts = ExtFlags {glasgowExtsEF = False,
+                       parrEF        = False}
+   case parse buf (mkPState loc exts) of
        PFailed err -> do
            freeStringBuffer buf
-            return (Left err)
+            throwDyn (InstallationError (showSDoc err))
 
        POk _ pkg_details -> do
            freeStringBuffer buf
-           return (Right pkg_details)
+           return pkg_details
 }