[project @ 2001-03-12 14:06:46 by simonpj]

----------------
	First cut at ILX
	----------------

This commit puts the ILX .NET code generator into the head.
It's entirely untested, mind you.

Some changes to the Module/Package strutures, mainly of a
naming variety.  In particular:

	Package	===> PackageConfig

ghc/compiler/basicTypes/Module.lhs

@@ -21,11 +21,17 @@ in a different DLL, by setting the DLL flag.
 \begin{code}
 module Module 
     (
-      Module, moduleName, packageOfModule,
-			    -- abstract, instance of Eq, Ord, Outputable
+      Module, 		   	-- Abstract, instance of Eq, Ord, Outputable
+
+    , PackageName		-- = FastString; instance of Outputable, Uniquable
+    , modulePackage		-- :: Module -> PackageName
+    , preludePackage		-- :: PackageName	name of Standard Prelude package
+
     , ModuleName
+    , pprModuleName		-- :: ModuleName -> SDoc
     , printModulePrefix
 
+    , moduleName		-- :: Module -> ModuleName 
     , moduleNameString		-- :: ModuleName -> EncodedString
     , moduleNameUserString	-- :: ModuleName -> UserString
     , moduleNameFS		-- :: ModuleName -> EncodedFS
@@ -45,8 +51,6 @@ module Module
 
     , pprModule,
  
-    , PackageName
-
 	-- Where to find a .hi file
     , WhereFrom(..)
 
@@ -65,8 +69,8 @@ module Module
 import OccName
 import Outputable
 import CmdLineOpts	( opt_InPackage )
-import FastString	( FastString, uniqueOfFS )
-import Unique		( Uniquable(..), mkUniqueGrimily )
+import FastString	( FastString )
+import Unique		( Uniquable(..) )
 import UniqFM
 import UniqSet
 \end{code}
@@ -94,7 +98,7 @@ renamer href here.)
 \begin{code}
 data Module = Module ModuleName PackageInfo
 
-data PackageInfo 
+data PackageInfo
   = ThisPackage				-- A module from the same package 
 					-- as the one being compiled
   | AnotherPackage PackageName		-- A module from a different package
@@ -103,18 +107,21 @@ data PackageInfo
 		-- Main case: we've come across Foo.x in an interface file
 		-- but we havn't yet opened Foo.hi.  We need a Name for Foo.x
 		-- Later on (in RnEnv.newTopBinder) we'll update the cache
-		-- to have the right PackageInfo
+		-- to have the right PackageName
 
 type PackageName = FastString		-- No encoding at all
 
 preludePackage :: PackageName
 preludePackage = SLIT("std")
 
+packageInfoPackage :: PackageInfo -> PackageName
+packageInfoPackage ThisPackage        = SLIT("<THIS>")
+packageInfoPackage DunnoYet	      = SLIT("<?>")
+packageInfoPackage (AnotherPackage p) = p
+
 instance Outputable PackageInfo where
 	-- Just used in debug prints of lex tokens and in debug modde
-   ppr ThisPackage        = ptext SLIT("<THIS>")
-   ppr DunnoYet		  = ptext SLIT("<?>")
-   ppr (AnotherPackage p) = ptext p
+   ppr pkg_info = ppr (packageInfoPackage pkg_info)
 \end{code}
 
 
@@ -152,7 +159,7 @@ newtype ModuleName = ModuleName EncodedFS
 	-- so the module names have the z-encoding applied to them
 
 instance Uniquable ModuleName where
-  getUnique (ModuleName nm) = mkUniqueGrimily (uniqueOfFS nm)
+  getUnique (ModuleName nm) = getUnique nm
 
 instance Eq ModuleName where
   nm1 == nm2 = getUnique nm1 == getUnique nm2
@@ -241,7 +248,7 @@ isHomeModule _                       = False
 
 -- Used temporarily when we first come across Foo.x in an interface
 -- file, but before we've opened Foo.hi.
--- (Until we've opened Foo.hi we don't know what the PackageInfo is.)
+-- (Until we've opened Foo.hi we don't know what the Package is.)
 mkVanillaModule :: ModuleName -> Module
 mkVanillaModule name = Module name DunnoYet
 
@@ -254,13 +261,12 @@ moduleString (Module (ModuleName fs) _) = _UNPK_ fs
 moduleName :: Module -> ModuleName
 moduleName (Module mod pkg_info) = mod
 
+modulePackage :: Module -> PackageName
+modulePackage (Module mod pkg_info) = packageInfoPackage pkg_info
+
 moduleUserString :: Module -> UserString
 moduleUserString (Module mod _) = moduleNameUserString mod
 
-packageOfModule :: Module -> Maybe PackageName
-packageOfModule (Module nm (AnotherPackage pn)) = Just pn
-packageOfModule _                               = Nothing
-
 printModulePrefix :: Module -> Bool
   -- When printing, say M.x
 printModulePrefix (Module nm ThisPackage) = False

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, defaultPackage )
+module CmStaticInfo ( GhciMode(..), PackageConfig(..), defaultPackageConfig )
 where
 
 #include "HsVersions.h"
@@ -15,10 +15,8 @@ where
 data GhciMode = Batch | Interactive | OneShot 
      deriving Eq
 
-type PackageConfigInfo = [Package]
-
-data Package
-   = Package {
+data PackageConfig
+   = PackageConfig {
 	name            :: String,
 	import_dirs     :: [String],
 	source_dirs     :: [String],
@@ -33,8 +31,8 @@ data Package
 	extra_ld_opts   :: [String]
      }
 
-defaultPackage
-   = Package {
+defaultPackageConfig
+   = PackageConfig {
 	name = error "defaultPackage",
 	import_dirs     = [],
 	source_dirs     = [],

ghc/compiler/ghci/InteractiveUI.hs

 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.53 2001/02/27 15:26:04 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.54 2001/03/12 14:06:46 simonpj Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -594,7 +594,7 @@ type LibrarySpec
 showLS (Left nm)  = "(static) " ++ nm
 showLS (Right nm) = "(dynamic) " ++ nm
 
-linkPackages :: [LibrarySpec] -> [Package] -> IO ()
+linkPackages :: [LibrarySpec] -> [PackageConfig] -> IO ()
 linkPackages cmdline_lib_specs pkgs
    = do mapM_ linkPackage pkgs
         mapM_ preloadLib cmdline_lib_specs
@@ -620,7 +620,7 @@ linkPackages cmdline_lib_specs pkgs
         croak = throwDyn (OtherError "user specified .o/.so/.DLL could not be loaded.")
 
 
-linkPackage :: Package -> IO ()
+linkPackage :: PackageConfig -> IO ()
 -- ignore rts and gmp for now (ToDo; better?)
 linkPackage pkg 
    | name pkg `elem` ["rts", "gmp"] 

ghc/compiler/main/CodeOutput.lhs

@@ -32,7 +32,6 @@ import ErrUtils		( dumpIfSet_dyn, showPass )
 import Outputable
 import CmdLineOpts	( DynFlags, HscLang(..), dopt_OutName )
 import TmpFiles		( newTempName )
-import UniqSupply	( mkSplitUniqSupply )
 
 import IO		( IOMode(..), hClose, openFile, Handle )
 \end{code}
@@ -74,7 +73,8 @@ codeOutput dflags mod_name tycons core_binds stg_binds
              HscJava        -> outputJava dflags filenm mod_name tycons core_binds
           		       >> return stub_names
 #ifdef ILX
-	     HscILX         -> outputIlx mod_name tycons stg_binds
+	     HscILX         -> outputIlx dflags filenm mod_name tycons stg_binds
+			       >> return stub_names
 #endif
 	}
 
@@ -155,8 +155,8 @@ outputJava dflags filenm mod tycons core_binds
 
 \begin{code}
 #ifdef ILX
-outputIlx mod tycons stg_binds
-  =  doOutput (\ f -> printForC f pp_ilx)
+outputIlx dflags filename mod tycons stg_binds
+  =  doOutput filename (\ f -> printForC f pp_ilx)
   where
     pp_ilx = ilxGen mod tycons stg_binds
 #endif

ghc/compiler/main/DriverFlags.hs

 {-# OPTIONS -#include "hschooks.h" #-}
 
 -----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.47 2001/03/08 09:50:18 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.48 2001/03/12 14:06:47 simonpj Exp $
 --
 -- Driver flags
 --
@@ -341,6 +341,7 @@ getOpts opts = dynFlag opts >>= return . reverse
 
 -- we can only change HscC to HscAsm and vice-versa with dynamic flags 
 -- (-fvia-C and -fasm).
+-- NB: we can also set the new lang to ILX, via -filx.  I hope this is right
 setLang l = do
    dfs <- readIORef v_DynFlags
    case hscLang dfs of
@@ -440,6 +441,9 @@ dynamic_flags = [
   ,  ( "fasm",		AnySuffix (\_ -> setLang HscAsm) )
   ,  ( "fvia-c",	NoArg (setLang HscC) )
   ,  ( "fvia-C",	NoArg (setLang HscC) )
+#ifdef ILX
+  ,  ( "filx",		NoArg (setLang HscILX) )
+#endif
 
 	-- "active negatives"
   ,  ( "fno-implicit-prelude",  NoArg (setDynFlag Opt_NoImplicitPrelude) )

ghc/compiler/main/DriverState.hs

 -----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.32 2001/03/05 12:45:45 simonpj Exp $
+-- $Id: DriverState.hs,v 1.33 2001/03/12 14:06:47 simonpj Exp $
 --
 -- Settings for the driver
 --
@@ -387,19 +387,19 @@ getPackageExtraLdOpts = do
   ps <- getPackageInfo
   return (concatMap extra_ld_opts ps)
 
-getPackageInfo :: IO [Package]
+getPackageInfo :: IO [PackageConfig]
 getPackageInfo = do
   ps <- readIORef v_Packages
   getPackageDetails ps
 
-getPackageDetails :: [String] -> IO [Package]
+getPackageDetails :: [String] -> IO [PackageConfig]
 getPackageDetails ps = do
   pkg_details <- readIORef v_Package_details
   return [ pkg | p <- ps, Just pkg <- [ lookupPkg p pkg_details ] ]
 
-GLOBAL_VAR(v_Package_details, (error "package_details"), [Package])
+GLOBAL_VAR(v_Package_details, (error "package_details"), [PackageConfig])
 
-lookupPkg :: String -> [Package] -> Maybe Package
+lookupPkg :: String -> [PackageConfig] -> Maybe PackageConfig
 lookupPkg nm ps
    = case [p | p <- ps, name p == nm] of
         []    -> Nothing

ghc/compiler/main/Finder.lhs

@@ -5,7 +5,7 @@
 
 \begin{code}
 module Finder (
-    initFinder, 	-- :: PackageConfigInfo -> IO (), 
+    initFinder, 	-- :: [PackageConfig] -> IO (), 
     findModule,		-- :: ModuleName -> IO (Maybe (Module, ModuleLocation))
     mkHomeModuleLocn,	-- :: ModuleName -> String -> FilePath 
 			--	-> IO ModuleLocation
@@ -49,7 +49,7 @@ GLOBAL_VAR(v_PkgDirCache, panic "no pkg cache!",
 GLOBAL_VAR(v_HomeDirCache, Nothing, Maybe (FiniteMap String FilePath))
 
 
-initFinder :: PackageConfigInfo -> IO ()
+initFinder :: [PackageConfig] -> IO ()
 initFinder pkgs 
   = do	{	-- expunge our home cache
 	; writeIORef v_HomeDirCache Nothing
@@ -160,7 +160,7 @@ mkHomeModuleLocn mod_name basename source_fn = do
 	))
 
 
-newPkgCache :: [Package] -> IO (FiniteMap String (PackageName, FilePath))
+newPkgCache :: [PackageConfig] -> IO (FiniteMap String (PackageName, FilePath))
 newPkgCache pkgs = do
     let extendFM fm pkg = do
     	    let dirs = import_dirs pkg

ghc/compiler/main/PackageMaintenance.hs

 -----------------------------------------------------------------------------
--- $Id: PackageMaintenance.hs,v 1.9 2001/03/08 11:44:16 simonmar Exp $
+-- $Id: PackageMaintenance.hs,v 1.10 2001/03/12 14:06:47 simonpj Exp $
 --
 -- GHC Driver program
 --
@@ -42,7 +42,7 @@ newPackage = do
   details <- readIORef v_Package_details
   hPutStr stdout "Reading package info from stdin... "
   stuff <- getContents
-  let new_pkg = read stuff :: Package
+  let new_pkg = read stuff :: PackageConfig
   catchAll new_pkg
   	(\_ -> throwDyn (OtherError "parse error in package info"))
   hPutStrLn stdout "done."
@@ -88,7 +88,7 @@ maybeRestoreOldConfig conf_file io
 	throw e
     )
 
-writeNewConfig :: String -> ([Package] -> [Package]) -> IO ()
+writeNewConfig :: String -> ([PackageConfig] -> [PackageConfig]) -> IO ()
 writeNewConfig conf_file fn = do
   hPutStr stdout "Writing new package config file... "
   old_details <- readIORef v_Package_details
@@ -109,14 +109,14 @@ savePackageConfig conf_file = do
 -----------------------------------------------------------------------------
 -- Pretty printing package info
 
-listPkgs :: [Package] -> String
+listPkgs :: [PackageConfig] -> String
 listPkgs pkgs = render (fsep (punctuate comma (map (text . name) pkgs)))
 
-dumpPackages :: [Package] -> String
+dumpPackages :: [PackageConfig] -> String
 dumpPackages pkgs = 
    render (brackets (vcat (punctuate comma (map dumpPkgGuts pkgs))))
 
-dumpPkgGuts :: Package -> Doc
+dumpPkgGuts :: PackageConfig -> Doc
 dumpPkgGuts pkg =
    text "Package" $$ nest 3 (braces (
       sep (punctuate comma [

ghc/compiler/main/ParsePkgConf.y

@@ -26,21 +26,21 @@ import Outputable
 %tokentype { Token }
 %%
 
-pkgconf :: { [ Package ] }
+pkgconf :: { [ PackageConfig ] }
 	: '[' pkgs ']'			{ reverse $2 }
 
-pkgs 	:: { [ Package ] }
+pkgs 	:: { [ PackageConfig ] }
 	: pkg 				{ [ $1 ] }
 	| pkgs ',' pkg			{ $3 : $1 }
 
-pkg 	:: { Package }
-	: CONID '{' fields '}'		{ $3 defaultPackage }
+pkg 	:: { PackageConfig }
+	: CONID '{' fields '}'		{ $3 defaultPackageConfig }
 
-fields  :: { Package -> Package }
+fields  :: { PackageConfig -> PackageConfig }
 	: field				{ \p -> $1 p }
 	| fields ',' field		{ \p -> $1 ($3 p) }
 
-field	:: { Package -> Package }
+field	:: { PackageConfig -> PackageConfig }
 	: VARID '=' STRING		
 		{\p -> case unpackFS $1 of
 		        "name" -> p{name = unpackFS $3} }
@@ -72,7 +72,7 @@ strs	:: { [String] }
 happyError :: P a
 happyError buf PState{ loc = loc } = PFailed (srcParseErr buf loc)
 
-parsePkgConf :: FilePath -> IO (Either SDoc [Package])
+parsePkgConf :: FilePath -> IO (Either SDoc [PackageConfig])
 parsePkgConf conf_filename = do
    buf <- hGetStringBuffer False conf_filename
    case parse buf PState{ bol = 0#, atbol = 1#,

ghc/compiler/rename/RnMonad.lhs

@@ -58,7 +58,7 @@ import Name		( Name, OccName, NamedThing(..),
 			  nameOccName,
 			  decode, mkLocalName, mkKnownKeyGlobal
 			)
-import NameEnv		( NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, extendNameEnvList )
+import NameEnv		( NameEnv, lookupNameEnv, emptyNameEnv, extendNameEnvList )
 import Module		( Module, ModuleName, ModuleSet, emptyModuleSet )
 import NameSet		
 import CmdLineOpts	( DynFlags, DynFlag(..), dopt )