From: simonmar <unknown>
Date: Tue, 6 Mar 2001 11:23:46 +0000 (+0000)
Subject: [project @ 2001-03-06 11:23:46 by simonmar]
X-Git-Tag: Approximately_9120_patches~2461
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=f86cb6a687090154668d2290c21ea6609fda5936;p=ghc-hetmet.git

[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
--- 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
--- 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
--- 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
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)
+}