Commit 9fdd90b0 authored by simonpj's avatar simonpj

[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
parent 6d6fccd0
......@@ -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
......
......@@ -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 = [],
......
-----------------------------------------------------------------------------
-- $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"]
......
This diff is collapsed.
......@@ -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
......
{-# 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) )
......
-----------------------------------------------------------------------------
-- $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
......
......@@ -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
......
-----------------------------------------------------------------------------
-- $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 [
......
......@@ -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#,
......
......@@ -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 )
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment