[project @ 2001-03-06 11:23:46 by simonmar]

- Add a Happy parser for the package config file.  This is faster and
  compiles to less code than the derived Read instance we had before.

- Add a source_dirs field to the package spec.  This isn't used by
  GHC, because we currently assume all packages are compiled.  It could
  be used by Hugs, though.

- Make unspecified fields of type [String] default to the empty list
  in a package spec.

diff --git a/ghc/compiler/compMan/CmStaticInfo.lhs b/ghc/compiler/compMan/CmStaticInfo.lhs
index a76ffc2..e267d70 100644 (file)
--- a/ghc/compiler/compMan/CmStaticInfo.lhs
+++ b/ghc/compiler/compMan/CmStaticInfo.lhs
@@ -4,7 +4,7 @@
 \section[CmStaticInfo]{Session-static info for the Compilation Manager}
 
 \begin{code}
-module CmStaticInfo ( GhciMode(..), Package(..), PackageConfigInfo )
+module CmStaticInfo ( GhciMode(..), Package(..), PackageConfigInfo, defaultPackage )
 where
 
 #include "HsVersions.h"
@@ -17,20 +17,35 @@ data GhciMode = Batch | Interactive | OneShot
 
 type PackageConfigInfo = [Package]
 
--- copied from the driver
 data Package
    = Package {
-        name            :: String,
-        import_dirs     :: [String],
-        library_dirs    :: [String],
-        hs_libraries    :: [String],
-        extra_libraries :: [String],
-        include_dirs    :: [String],
-        c_includes      :: [String],
-        package_deps    :: [String],
-        extra_ghc_opts  :: [String],
-        extra_cc_opts   :: [String],
-        extra_ld_opts   :: [String]
+       name            :: String,
+       import_dirs     :: [String],
+       source_dirs     :: [String],
+       library_dirs    :: [String],
+       hs_libraries    :: [String],
+       extra_libraries :: [String],
+       include_dirs    :: [String],
+       c_includes      :: [String],
+       package_deps    :: [String],
+       extra_ghc_opts  :: [String],
+       extra_cc_opts   :: [String],
+       extra_ld_opts   :: [String]
      }
-  deriving Read
+
+defaultPackage
+   = Package {
+       name = error "defaultPackage",
+       import_dirs     = [],
+       source_dirs     = [],
+       library_dirs    = [],
+       hs_libraries    = [],
+       extra_libraries = [],
+       include_dirs    = [],
+       c_includes      = [],
+       package_deps    = [],
+       extra_ghc_opts  = [],
+       extra_cc_opts   = [],
+       extra_ld_opts   = []
+    }
 \end{code}

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 1753cd3..5c98696 100644 (file)
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -fno-warn-incomplete-patterns #-}
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.58 2001/03/05 12:18:21 simonpj Exp $
+-- $Id: Main.hs,v 1.59 2001/03/06 11:23:46 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -27,6 +27,7 @@ import Posix
 #endif
 
 import CompManager
+import ParsePkgConf
 import DriverPipeline
 import DriverState
 import DriverFlags
@@ -39,9 +40,9 @@ import TmpFiles
 import Finder          ( initFinder )
 import CmStaticInfo
 import Config
+import Outputable
 import Util
 
-
 import Concurrent
 import Directory
 import IOExts
@@ -155,8 +156,11 @@ main =
 
        -- read the package configuration
    conf_file <- readIORef v_Path_package_config
-   contents <- readFile conf_file
-   let pkg_details = read contents     -- ToDo: faster
+   r <- parsePkgConf conf_file
+   case r of {
+       Left err -> throwDyn (OtherError (showSDoc err));
+       Right pkg_details -> do
+
    writeIORef v_Package_details pkg_details
 
        -- find the phase to stop after (i.e. -E, -C, -c, -S flags)
@@ -297,7 +301,7 @@ main =
    when (mode == DoMkDependHS) endMkDependHS
    when (mode == DoLink) (doLink o_files)
    when (mode == DoMkDLL) (doMkDLL o_files)
-
+  }
        -- grab the last -B option on the command line, and
        -- set topDir to its value.
 setTopDir :: [String] -> IO [String]

diff --git a/ghc/compiler/main/PackageMaintenance.hs b/ghc/compiler/main/PackageMaintenance.hs
index bd296d4..1722ea5 100644 (file)
--- a/ghc/compiler/main/PackageMaintenance.hs
+++ b/ghc/compiler/main/PackageMaintenance.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: PackageMaintenance.hs,v 1.6 2000/12/18 20:42:14 qrczak Exp $
+-- $Id: PackageMaintenance.hs,v 1.7 2001/03/06 11:23:46 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -37,6 +37,7 @@ listPackages = do
 
 newPackage :: IO ()
 newPackage = do
+  error "wibble" {-
   checkConfigAccess
   details <- readIORef v_Package_details
   hPutStr stdout "Reading package info from stdin... "
@@ -54,6 +55,7 @@ newPackage = do
   maybeRestoreOldConfig conf_file $ do
   writeNewConfig conf_file ( ++ [new_pkg])
   exitWith ExitSuccess
+-}
 
 deletePackage :: String -> IO ()
 deletePackage pkg = do  

diff --git a/ghc/compiler/main/ParsePkgConf.y b/ghc/compiler/main/ParsePkgConf.y
new file mode 100644 (file)
index 0000000..a3e569d
--- /dev/null
+++ b/ghc/compiler/main/ParsePkgConf.y
@@ -0,0 +1,88 @@
+{
+module ParsePkgConf (parsePkgConf) where
+import CmStaticInfo
+import Lex
+import FastString
+import StringBuffer
+import SrcLoc
+import Outputable
+#include "HsVersions.h"
+}
+
+%token
+ '{'           { ITocurly }
+ '}'           { ITccurly }
+ '['           { ITobrack }
+ ']'           { ITcbrack }
+ ','           { ITcomma }
+ '='           { ITequal }
+ VARID         { ITvarid    $$ }
+ CONID         { ITconid    $$ }
+ STRING                { ITstring   $$ }
+
+%monad { P } { thenP } { returnP }
+%lexer { lexer } { ITeof }
+%name parse
+%tokentype { Token }
+%%
+
+pkgconf :: { [ Package ] }
+       : '[' pkgs ']'                  { reverse $2 }
+
+pkgs   :: { [ Package ] }
+       : pkg                           { [ $1 ] }
+       | pkgs ',' pkg                  { $3 : $1 }
+
+pkg    :: { Package }
+       : CONID '{' fields '}'          { $3 defaultPackage }
+
+fields  :: { Package -> Package }
+       : field                         { \p -> $1 p }
+       | fields ',' field              { \p -> $1 ($3 p) }
+
+field  :: { Package -> Package }
+       : VARID '=' STRING              
+               {\p -> case unpackFS $1 of
+                       "name" -> p{name = unpackFS $3} }
+                       
+       | VARID '=' strlist             
+               {\p -> case unpackFS $1 of
+                       "import_dirs"     -> p{import_dirs     = $3}
+                       "library_dirs"    -> p{library_dirs    = $3}
+                       "hs_libraries"    -> p{hs_libraries    = $3}
+                       "extra_libraries" -> p{extra_libraries = $3}
+                       "include_dirs"    -> p{include_dirs    = $3}
+                       "c_includes"      -> p{c_includes      = $3}
+                       "package_deps"    -> p{package_deps    = $3}
+                       "extra_ghc_opts"  -> p{extra_ghc_opts  = $3}
+                       "extra_cc_opts"   -> p{extra_cc_opts   = $3}
+                       "extra_ld_opts"   -> p{extra_ld_opts   = $3}
+                       _other            -> p
+               }
+
+strlist :: { [String] }
+        : '[' ']'                      { [] }
+       | '[' strs ']'                  { reverse $2 }
+
+strs   :: { [String] }
+       : STRING                        { [ unpackFS $1 ] }
+       | strs ',' STRING               { unpackFS $3 : $1 }
+
+{
+happyError :: P a
+happyError buf PState{ loc = loc } = PFailed (srcParseErr buf loc)
+
+parsePkgConf :: FilePath -> IO (Either SDoc [Package])
+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
+       PFailed err -> do
+           freeStringBuffer buf
+            return (Left err)
+
+       POk _ pkg_details -> do
+           freeStringBuffer buf
+           return (Right pkg_details)
+}