Commit ce9687a5 authored by simonmar's avatar simonmar
Browse files

[project @ 2002-08-29 15:44:11 by simonmar]

Housekeeping:

  - The main goal is to remove dependencies on hslibs for a
    bootstrapped compiler, leaving only a requirement that the
    packages base, haskell98 and readline are built in stage 1 in
    order to bootstrap.  We're almost there: Posix is still required
    for signal handling, but all other dependencies on hslibs are now
    gone.

    Uses of Addr and ByteArray/MutableByteArray array are all gone
    from the compiler.  PrimPacked defines the Ptr type for GHC 4.08
    (which didn't have it), and it defines simple BA and MBA types to
    replace uses of ByteArray and MutableByteArray respectively.

  - Clean up import lists.  HsVersions.h now defines macros for some
    modules which have moved between GHC versions.  eg. one now
    imports 'GLAEXTS' to get at unboxed types and primops in the
    compiler.

    Many import lists have been sorted as per the recommendations in
    the new style guidelines in the commentary.

I've built the compiler with GHC 4.08.2, 5.00.2, 5.02.3, 5.04 and
itself, and everything still works here.  Doubtless I've got something
wrong, though.
parent 4a851c82
......@@ -10,6 +10,36 @@ you will screw up the layout where they are used in case expressions!
#endif
#if __GLASGOW_HASKELL__ >= 504
#define CONCURRENT Control.Concurrent
#define EXCEPTION Control.Exception
#define DYNAMIC Data.Dynamic
#define GLAEXTS GHC.Exts
#define DATA_BITS Data.Bits
#define DATA_INT Data.Int
#define DATA_WORD Data.Word
#define UNSAFE_IO System.IO.Unsafe
#define TRACE Debug.Trace
#define DATA_IOREF Data.IORef
#define FIX_IO System.IO
#else
#define CONCURRENT Concurrent
#define EXCEPTION Exception
#define DYNAMIC Dynamic
#define GLAEXTS GlaExts
#define DATA_BITS Bits
#define DATA_INT Int
#define DATA_WORD Word
#define UNSAFE_IO IOExts
#define TRACE IOExts
#define DATA_IOREF IOExts
#define FIX_IO IOExts
#endif
#ifdef __GLASGOW_HASKELL__
#define GLOBAL_VAR(name,value,ty) \
name = Util.global (value) :: IORef (ty); \
......
# -----------------------------------------------------------------------------
# $Id: Makefile,v 1.219 2002/06/14 08:23:57 simonpj Exp $
# $Id: Makefile,v 1.220 2002/08/29 15:44:12 simonmar Exp $
TOP = ..
......@@ -232,14 +232,6 @@ ifeq "$(bootstrapped)" "YES"
utils/Binary_HC_OPTS = -funbox-strict-fields
endif
# flags for PrimPacked:
#
# -monly-2-regs
# because it contains 'ccall strlen' and 'ccall memcmp', which gets
# inlined by gcc, causing a lack of registers.
#
utils/PrimPacked_HC_OPTS = -fvia-C
# ByteCodeItbls uses primops that the NCG doesn't support yet.
ghci/ByteCodeItbls_HC_OPTS = -fvia-C
ghci/ByteCodeLink_HC_OPTS = -fvia-C -monly-3-regs
......@@ -368,10 +360,16 @@ endif
# ----------------------------------------------------------------------------
# profiling.
rename/Rename_HC_OPTS += -auto-all
rename/RnEnv_HC_OPTS += -auto-all
rename/RnHiFiles_HC_OPTS += -auto-all
rename/RnSource_HC_OPTS += -auto-all
# rename/Rename_HC_OPTS += -auto-all
# rename/RnEnv_HC_OPTS += -auto-all
# rename/RnHiFiles_HC_OPTS += -auto-all
# rename/RnIfaces_HC_OPTS += -auto-all
# rename/RnSource_HC_OPTS += -auto-all
# rename/RnBinds_HC_OPTS += -auto-all
# rename/RnExpr_HC_OPTS += -auto-all
# rename/RnHsSyn_HC_OPTS += -auto-all
# rename/RnNames_HC_OPTS += -auto-all
# rename/RnTypes_HC_OPTS += -auto-all
#-----------------------------------------------------------------------------
# clean
......
......@@ -58,10 +58,14 @@ import UniqSet ( emptyUniqSet, elementOfUniqSet,
import StgSyn ( StgOp(..) )
import BitSet ( BitSet, intBS )
import Outputable
import GlaExts
import FastString
import Util ( lengthExceeds, listLengthCmp )
#if __GLASGOW_HASKELL__ >= 504
import Data.Array.ST
#endif
import GLAEXTS
import ST
infixr 9 `thenTE`
......@@ -1764,13 +1768,46 @@ can safely initialise to static locations.
\begin{code}
big_doubles = (getPrimRepSize DoubleRep) /= 1
-- floatss are always 1 word
#if __GLASGOW_HASKELL__ >= 504
newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float)
newFloatArray = newArray_
newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double)
newDoubleArray = newArray_
castFloatToIntArray :: STUArray s Int Float -> ST s (STUArray s Int Int)
castFloatToIntArray = castSTUArray
castDoubleToIntArray :: STUArray s Int Double -> ST s (STUArray s Int Int)
castDoubleToIntArray = castSTUArray
writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s ()
writeFloatArray = writeArray
writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s ()
writeDoubleArray = writeArray
readIntArray :: STUArray s Int Int -> Int -> ST s Int
readIntArray = readArray
#else
castFloatToIntArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
castFloatToIntArray = return
castDoubleToIntArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
castDoubleToIntArray = return
#endif
-- floats are always 1 word
floatToWord :: CAddrMode -> CAddrMode
floatToWord (CLit (MachFloat r))
= runST (do
arr <- newFloatArray ((0::Int),0)
writeFloatArray arr 0 (fromRational r)
i <- readIntArray arr 0
arr' <- castFloatToIntArray arr
i <- readIntArray arr' 0
return (CLit (MachInt (toInteger i)))
)
......@@ -1780,8 +1817,9 @@ doubleToWords (CLit (MachDouble r))
= runST (do
arr <- newDoubleArray ((0::Int),1)
writeDoubleArray arr 0 (fromRational r)
i1 <- readIntArray arr 0
i2 <- readIntArray arr 1
arr' <- castDoubleToIntArray arr
i1 <- readIntArray arr' 0
i2 <- readIntArray arr' 1
return [ CLit (MachInt (toInteger i1))
, CLit (MachInt (toInteger i2))
]
......@@ -1790,7 +1828,8 @@ doubleToWords (CLit (MachDouble r))
= runST (do
arr <- newDoubleArray ((0::Int),0)
writeDoubleArray arr 0 (fromRational r)
i <- readIntArray arr 0
arr' <- castDoubleToIntArray arr
i <- readIntArray arr' 0
return [ CLit (MachInt (toInteger i)) ]
)
\end{code}
......@@ -50,7 +50,7 @@ import FastString
import Outputable
import Binary
import GlaExts
import GLAEXTS
\end{code}
We hold both module names and identifier names in a 'Z-encoded' form
......
......@@ -31,7 +31,8 @@ import Outputable
import FastString ( unpackFS )
import FastTypes
import FastString
import GlaExts ( (+#) )
import GLAEXTS ( (+#) )
\end{code}
%************************************************************************
......
......@@ -24,12 +24,9 @@ module UniqSupply (
#include "HsVersions.h"
import Unique
import GlaExts
#if __GLASGOW_HASKELL__ < 301
import IOBase ( IO(..), IOResult(..) )
#else
#endif
import GLAEXTS
import UNSAFE_IO ( unsafeInterleaveIO )
w2i x = word2Int# x
i2w x = int2Word# x
......
......@@ -49,12 +49,12 @@ module Unique (
import BasicTypes ( Boxity(..) )
import FastString ( FastString, uniqueOfFS )
import GlaExts
import ST
import Char ( chr, ord )
import Outputable
import FastTypes
import Outputable
import GLAEXTS
import Char ( chr, ord )
\end{code}
%************************************************************************
......@@ -227,48 +227,21 @@ instance Show Unique where
A character-stingy way to read/write numbers (notably Uniques).
The ``62-its'' are \tr{[0-9a-zA-Z]}. We don't handle negative Ints.
Code stolen from Lennart.
\begin{code}
# define BYTE_ARRAY GlaExts.ByteArray
# define RUN_ST ST.runST
# define AND_THEN >>=
# define AND_THEN_ >>
# define RETURN return
\begin{code}
iToBase62 :: Int -> SDoc
iToBase62 n@(I# n#)
= ASSERT(n >= 0)
let
#if __GLASGOW_HASKELL__ < 405
bytes = case chars62 of { BYTE_ARRAY bounds_who_needs_'em bytes -> bytes }
#else
bytes = case chars62 of { BYTE_ARRAY _ _ bytes -> bytes }
#endif
in
if n# <# 62# then
case (indexCharArray# bytes n#) of { c ->
case (indexCharOffAddr# chars62# n#) of { c ->
char (C# c) }
else
case (quotRem n 62) of { (q, I# r#) ->
case (indexCharArray# bytes r#) of { c ->
case (indexCharOffAddr# chars62# r#) of { c ->
(<>) (iToBase62 q) (char (C# c)) }}
-- keep this at top level! (bug on 94/10/24 WDP)
chars62 :: BYTE_ARRAY Int
chars62
= RUN_ST (
newCharArray (0, 61) AND_THEN \ ch_array ->
fill_in ch_array 0 62 "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
AND_THEN_
unsafeFreezeByteArray ch_array
)
where
fill_in ch_array i lim str
| i == lim
= RETURN ()
| otherwise
= writeCharArray ch_array i (str !! i) AND_THEN_
fill_in ch_array (i+1) lim str
chars62# = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
\end{code}
%************************************************************************
......
......@@ -47,7 +47,7 @@ import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey )
import FastTypes
import Outputable
import IOExts ( IORef, newIORef, readIORef, writeIORef )
import DATA_IOREF ( IORef, newIORef, readIORef, writeIORef )
\end{code}
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgHeapery.lhs,v 1.31 2002/04/29 14:03:41 simonmar Exp $
% $Id: CgHeapery.lhs,v 1.32 2002/08/29 15:44:13 simonmar Exp $
%
\section[CgHeapery]{Heap management functions}
......@@ -31,12 +31,13 @@ import ClosureInfo ( closureSize, closureGoodStuffSize,
import PrimRep ( PrimRep(..), isFollowableRep )
import Unique ( Unique )
import CmdLineOpts ( opt_GranMacros )
import GlaExts
import Outputable
#ifdef DEBUG
import PprAbsC ( pprMagicId ) -- tmp
#endif
import GLAEXTS
\end{code}
%************************************************************************
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgStackery.lhs,v 1.20 2001/10/03 13:57:42 simonmar Exp $
% $Id: CgStackery.lhs,v 1.21 2002/08/29 15:44:13 simonmar Exp $
%
\section[CgStackery]{Stack management functions}
......@@ -27,12 +27,10 @@ import AbsCUtils ( mkAbstractCs, getAmodeRep )
import PrimRep ( getPrimRepSize, PrimRep(..), isFollowableRep )
import CmdLineOpts ( opt_SccProfilingOn, opt_GranMacros )
import Panic ( panic )
import Constants ( uF_SIZE, pROF_UF_SIZE, gRAN_UF_SIZE,
sEQ_FRAME_SIZE, pROF_SEQ_FRAME_SIZE,
gRAN_SEQ_FRAME_SIZE )
import Constants
import Util ( sortLt )
import IOExts ( trace )
import TRACE ( trace )
\end{code}
%************************************************************************
......
......@@ -57,7 +57,7 @@ import Panic ( assertPanic )
import Outputable
#endif
import IOExts ( readIORef )
import DATA_IOREF ( readIORef )
\end{code}
\begin{code}
......
......@@ -20,19 +20,22 @@ module CmLink (
) where
#include "HsVersions.h"
#ifdef GHCI
import ByteCodeLink ( linkIModules, linkIExpr )
import Interpreter
import Name ( Name )
import FiniteMap
import ErrUtils ( showPass )
import DATA_IOREF ( readIORef, writeIORef )
#endif
import Interpreter
import DriverPipeline
import CmTypes
import HscTypes ( GhciMode(..) )
import Name ( Name )
import Module ( ModuleName )
import FiniteMap
import Outputable
import ErrUtils ( showPass )
import CmdLineOpts ( DynFlags(..) )
import Util
......@@ -40,13 +43,12 @@ import Util
import Exception ( block )
#endif
import IOExts
import DATA_IOREF ( IORef )
import List
import Monad
import IO
#include "HsVersions.h"
-- ---------------------------------------------------------------------------
-- The Linker's state
......@@ -114,6 +116,7 @@ filterModuleLinkables p (li:lis)
dump = filterModuleLinkables p lis
retain = li : dump
#ifdef GHCI
linkableInSet :: Linkable -> [Linkable] -> Bool
linkableInSet l objs_loaded =
case findModuleLinkable_maybe objs_loaded (linkableModName l) of
......@@ -122,7 +125,6 @@ linkableInSet l objs_loaded =
-- These two are used to add/remove entries from the closure env for
-- new bindings made at the prompt.
#ifdef GHCI
delListFromClosureEnv :: PersistentLinkerState -> [Name]
-> IO PersistentLinkerState
delListFromClosureEnv pls names
......
......@@ -106,8 +106,7 @@ import CForeign
import Exception ( Exception, try )
#endif
-- lang
import Exception ( throwDyn )
import EXCEPTION ( throwDyn )
-- std
import Directory ( getModificationTime, doesFileExist )
......
......@@ -59,7 +59,7 @@ import Outputable
import Util
#if __GLASGOW_HASKELL__ >= 404
import GlaExts ( Int# )
import GLAEXTS ( Int# )
#endif
\end{code}
......
......@@ -17,9 +17,10 @@ import ForeignCall ( CCallConv(..) )
import Bits ( Bits(..), shiftR, shiftL )
import Foreign ( newArray )
import Word ( Word8, Word32 )
import Data.Word ( Word8, Word32 )
import Foreign ( Ptr, mallocBytes )
import IOExts ( trace, unsafePerformIO )
import Debug.Trace ( trace )
import System.IO.Unsafe ( unsafePerformIO )
import IO ( hPutStrLn, stderr )
\end{code}
......
......@@ -54,15 +54,9 @@ import Control.Exception ( throwDyn )
import GlaExts ( BCO#, newBCO#, unsafeCoerce#,
ByteArray#, Array#, addrToHValue#, mkApUpd0# )
#if __GLASGOW_HASKELL__ >= 503
import GHC.Arr ( Array(..) )
import GHC.IOBase ( IO(..) )
import GHC.Ptr ( Ptr(..) )
#else
import PrelArr ( Array(..) )
import PrelIOBase ( IO(..) )
import Ptr ( Ptr(..) )
#endif
\end{code}
%************************************************************************
......
{-# OPTIONS -#include "Linker.h" -#include "SchedAPI.h" #-}
-----------------------------------------------------------------------------
-- $Id: InteractiveUI.hs,v 1.131 2002/08/05 09:18:27 simonmar Exp $
-- $Id: InteractiveUI.hs,v 1.132 2002/08/29 15:44:14 simonmar Exp $
--
-- GHC Interactive User Interface
--
......@@ -38,7 +38,6 @@ import TyCon ( tyConName, tyConClass_maybe, isPrimTyCon, DataConDetails(..) )
import FieldLabel ( fieldLabelTyCon )
import SrcLoc ( isGoodSrcLoc )
import Module ( moduleName )
import NameEnv ( nameEnvElts )
import Name ( Name, isHomePackageName, nameSrcLoc, nameOccName,
NamedThing(..) )
import OccName ( isSymOcc )
......@@ -53,28 +52,32 @@ import Config
import Posix
#endif
import Exception
import Dynamic
#if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
import Readline
#endif
import Concurrent
import IOExts
import SystemExts
--import SystemExts
import Control.Exception as Exception
import Data.Dynamic
import Control.Concurrent
import Numeric
import List
import System
import CPUTime
import Directory
import IO
import Char
import Monad
import Data.List
import System.Cmd
import System.CPUTime
import System.Environment
import System.Directory
import System.IO as IO
import Data.Char
import Control.Monad as Monad
import GlaExts ( unsafeCoerce# )
import GHC.Exts ( unsafeCoerce# )
import Foreign ( nullPtr )
import CString ( CString, peekCString, withCString )
import Foreign.C.String ( CString, peekCString, withCString )
import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
-----------------------------------------------------------------------------
......
......@@ -7,6 +7,8 @@
module BinIface ( writeBinIface ) where
#include "HsVersions.h"
import HscTypes
import BasicTypes
import NewDemand
......@@ -28,14 +30,12 @@ import CmdLineOpts ( opt_IgnoreIfacePragmas, opt_HiVersion )
import StringBuffer ( hGetStringBuffer )
import Panic
import SrcLoc
import Binary
import IOExts ( readIORef )
import Monad ( when )
import Exception ( throwDyn )
import DATA_IOREF ( readIORef )
import EXCEPTION ( throwDyn )
#include "HsVersions.h"
import Monad ( when )
-- BasicTypes
{-! for IPName derive: Binary !-}
......
......@@ -117,15 +117,15 @@ module CmdLineOpts (
#include "HsVersions.h"
import GlaExts
import IOExts ( IORef, readIORef, writeIORef )
import Constants -- Default values for some flags
import Util
import FastTypes
import FastString ( FastString, mkFastString )
import Config
import Maybes ( firstJust )
import GLAEXTS
import DATA_IOREF ( IORef, readIORef, writeIORef )
import UNSAFE_IO ( unsafePerformIO )
\end{code}
%************************************************************************
......
......@@ -20,13 +20,13 @@ import IlxGen ( ilxGen )
#ifdef JAVA
import JavaGen ( javaGen )
import qualified PrintJava
import OccurAnal ( occurAnalyseBinds )
#endif
import DriverState ( v_HCHeader )
import TyCon ( TyCon )
import Id ( Id )
import CoreSyn ( CoreBind )
import OccurAnal ( occurAnalyseBinds )
import StgSyn ( StgBinding )
import AbsCSyn ( AbstractC )
import PprAbsC ( dumpRealC, writeRealC )
......@@ -37,7 +37,8 @@ import Outputable
import Pretty ( Mode(..), printDoc )
import CmdLineOpts ( DynFlags, HscLang(..), dopt_OutName )
import IOExts
import DATA_IOREF ( readIORef )
import Monad ( when )
import IO
\end{code}
......
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