[project @ 2002-09-06 14:35:42 by simonmar]

Finally separate the compiler from hslibs.

Mainly import wibbles, and use the new POSIX library when
bootstrapping.

diff --git a/ghc/compiler/HsVersions.h b/ghc/compiler/HsVersions.h
index 62c9c07..0560611 100644 (file)
--- a/ghc/compiler/HsVersions.h
+++ b/ghc/compiler/HsVersions.h
@@ -23,6 +23,8 @@ you will screw up the layout where they are used in case expressions!
 #define TRACE       Debug.Trace
 #define DATA_IOREF  Data.IORef
 #define FIX_IO      System.IO
+#define MONAD_ST    Control.Monad.ST
+#define ST_ARRAY    Data.Array.ST
 
 #else
 
@@ -37,6 +39,8 @@ you will screw up the layout where they are used in case expressions!
 #define TRACE       IOExts
 #define DATA_IOREF  IOExts
 #define FIX_IO      IOExts
+#define MONAD_ST    ST
+#define ST_ARRAY    ST
 
 #endif
 

diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile
index cc46148..531ec2a 100644 (file)
--- a/ghc/compiler/Makefile
+++ b/ghc/compiler/Makefile
@@ -1,5 +1,5 @@
 # -----------------------------------------------------------------------------
-# $Id: Makefile,v 1.220 2002/08/29 15:44:12 simonmar Exp $
+# $Id: Makefile,v 1.221 2002/09/06 14:35:43 simonmar Exp $
 
 TOP = ..
 
@@ -134,7 +134,10 @@ endif
 # Only include GHCi if we're bootstrapping with at least version 411
 ifeq "$(GhcWithInterpreter)" "YES"
 ifeq "$(bootstrapped)" "YES"
-SRC_HC_OPTS += -DGHCI
+SRC_HC_OPTS += -DGHCI -package readline
+ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
+SRC_HC_OPTS += -package unix
+endif
 ALL_DIRS += ghci
 endif
 endif
@@ -184,11 +187,15 @@ SRC_HC_OPTS += \
 # which needs it).
 SRC_MKDEPENDHS_OPTS += -I$(GHC_INCLUDE_DIR)
 
+# When bootstrapped, we don't make use of *any* packages
+# (except possibly readline if GHCi is enabled, see above)
+ifneq "$(bootstrapped)" "YES"
 ifneq "$(mingw32_HOST_OS)" "1"
 SRC_HC_OPTS += -package concurrent -package posix -package util
 else
 SRC_HC_OPTS += -package concurrent -package util
 endif
+endif
 
 SRC_CC_OPTS += -Iparser -I. -I$(TOP)/includes -O
 SRC_HC_OPTS += -recomp $(GhcHcOpts)

diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs
index fff3006..58cf18f 100644 (file)
--- a/ghc/compiler/absCSyn/PprAbsC.lhs
+++ b/ghc/compiler/absCSyn/PprAbsC.lhs
@@ -66,7 +66,7 @@ import Data.Array.ST
 #endif
 
 import GLAEXTS
-import ST
+import MONAD_ST
 
 infixr 9 `thenTE`
 \end{code}

diff --git a/ghc/compiler/deSugar/DsCCall.lhs b/ghc/compiler/deSugar/DsCCall.lhs
index 19bddd3..23743bd 100644 (file)
--- a/ghc/compiler/deSugar/DsCCall.lhs
+++ b/ghc/compiler/deSugar/DsCCall.lhs
@@ -220,11 +220,6 @@ boxResult :: [Id] -> Type -> DsM (Type, CoreExpr -> CoreExpr)
 -- the result type will be 
 --     State# RealWorld -> (# State# RealWorld #)
 
--- Here is where we arrange that ForeignPtrs which are passed to a 'safe'
--- foreign import don't get finalized until the call returns.  For each
--- argument of type ForeignObj# we arrange to touch# the argument after
--- the call.  The arg_ids passed in are the Ids passed to the actual ccall.
-
 boxResult arg_ids result_ty
   = case tcSplitTyConApp_maybe result_ty of
        -- This split absolutely has to be a tcSplit, because we must
@@ -267,13 +262,11 @@ boxResult arg_ids result_ty
   where
     mk_alt return_result (Nothing, wrap_result)
        =       -- The ccall returns ()
-         let
-               rhs_fun state_id = return_result (Var state_id) 
-                                       (wrap_result (panic "boxResult"))
-         in
          newSysLocalDs realWorldStatePrimTy    `thenDs` \ state_id ->
-         mkTouches arg_ids state_id rhs_fun    `thenDs` \ the_rhs ->
          let
+               the_rhs = return_result (Var state_id) 
+                                       (wrap_result (panic "boxResult"))
+
                ccall_res_ty = mkTyConApp unboxedSingletonTyCon [realWorldStatePrimTy]
                the_alt      = (DataAlt unboxedSingletonDataCon, [state_id], the_rhs)
          in
@@ -282,28 +275,16 @@ boxResult arg_ids result_ty
     mk_alt return_result (Just prim_res_ty, wrap_result)
        =       -- The ccall returns a non-() value
          newSysLocalDs prim_res_ty             `thenDs` \ result_id ->
-         let
-               rhs_fun state_id = return_result (Var state_id) 
-                                       (wrap_result (Var result_id))
-         in
          newSysLocalDs realWorldStatePrimTy    `thenDs` \ state_id ->
-         mkTouches arg_ids state_id rhs_fun    `thenDs` \ the_rhs ->
          let
+               the_rhs = return_result (Var state_id) 
+                                       (wrap_result (Var result_id))
+
                ccall_res_ty = mkTyConApp unboxedPairTyCon [realWorldStatePrimTy, prim_res_ty]
                the_alt      = (DataAlt unboxedPairDataCon, [state_id, result_id], the_rhs)
          in
          returnDs (ccall_res_ty, the_alt)
 
-touchzh = mkPrimOpId TouchOp
-
-mkTouches []     s cont = returnDs (cont s)
-mkTouches (v:vs) s cont
-  | not (idType v `eqType` foreignObjPrimTy) = mkTouches vs s cont
-  | otherwise = newSysLocalDs realWorldStatePrimTy `thenDs` \s' -> 
-               mkTouches vs s' cont `thenDs` \ rest ->
-               returnDs (Case (mkApps (Var touchzh) [Type foreignObjPrimTy, 
-                                                     Var v, Var s]) s' 
-                               [(DEFAULT, [], rest)])
 
 resultWrapper :: Type
              -> (Maybe Type,           -- Type of the expected result, if any

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 4825368..14208e1 100644 (file)
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -#include "Linker.h" -#include "SchedAPI.h" #-}
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.132 2002/08/29 15:44:14 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.133 2002/09/06 14:35:44 simonmar Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -49,11 +49,11 @@ import Panic                ( GhcException(..), showGhcException )
 import Config
 
 #ifndef mingw32_TARGET_OS
-import Posix
+import System.Posix
 #endif
 
 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
-import Readline 
+import System.Console.Readline as Readline
 #endif
 
 --import SystemExts

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 5687bfb..8c55d44 100644 (file)
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
 
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.109 2002/08/29 15:44:15 simonmar Exp $
+-- $Id: Main.hs,v 1.110 2002/09/06 14:35:44 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -69,7 +69,12 @@ import EXCEPTION        ( raiseInThread )
 import EXCEPTION       ( throwTo )
 # endif
 
+#if __GLASGOW_HASKELL__ > 504
+import System.Posix.Signals
+#else
 import Posix           ( Handler(Catch), installHandler, sigINT, sigQUIT )
+#endif
+
 import DYNAMIC         ( toDyn )
 #endif
 

diff --git a/ghc/compiler/main/ParsePkgConf.y b/ghc/compiler/main/ParsePkgConf.y
index 71fe194..e916111 100644 (file)
--- a/ghc/compiler/main/ParsePkgConf.y
+++ b/ghc/compiler/main/ParsePkgConf.y
@@ -1,6 +1,8 @@
 {
 module ParsePkgConf( loadPackageConfig ) where
 
+#include "HsVersions.h"
+
 import Packages  ( PackageConfig(..), defaultPackageConfig )
 import Lex
 import FastString
@@ -8,9 +10,7 @@ import StringBuffer
 import SrcLoc
 import Outputable
 import Panic     ( GhcException(..) )
-import Exception ( throwDyn )
-
-#include "HsVersions.h"
+import EXCEPTION ( throwDyn )
 
 }
 

diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
index 8b2ab35..bca9a7e 100644 (file)
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -94,13 +94,17 @@ import Directory    ( doesFileExist, removeFile )
 #endif
 
 #ifndef mingw32_HOST_OS
+#if __GLASGOW_HASKELL__ > 504
+import qualified GHC.Posix
+#else
 import qualified Posix
+#endif
 #else
 import List            ( isPrefixOf )
 import Util            ( dropList )
 import MarshalArray
 import Foreign
-import Foreign.C.String
+import CString
 #endif
 
 #ifdef mingw32_HOST_OS
@@ -856,6 +860,9 @@ getExecDir :: IO (Maybe String) = do return Nothing
 
 #ifdef mingw32_HOST_OS
 foreign import "_getpid" unsafe getProcessID :: IO Int -- relies on Int == Int32 on Windows
+#elif __GLASGOW_HASKELL__ > 504
+getProcessID :: IO Int
+getProcessID = GHC.Posix.c_getpid >>= return . fromIntegral
 #else
 getProcessID :: IO Int
 getProcessID = Posix.getProcessID

diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs
index 6f75890..564a799 100644 (file)
--- a/ghc/compiler/nativeGen/PprMach.lhs
+++ b/ghc/compiler/nativeGen/PprMach.lhs
@@ -32,7 +32,7 @@ import Data.Word      ( Word8 )
 import MutableArray
 #endif
 
-import ST
+import MONAD_ST
 
 import Char            ( chr, ord )
 import Maybe           ( isJust )

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index ea8f6f5..f128af2 100644 (file)
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-                                                             -*-haskell-*-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.100 2002/06/07 07:16:05 chak Exp $
+$Id: Parser.y,v 1.101 2002/09/06 14:35:44 simonmar Exp $
 
 Haskell grammar.
 
@@ -11,6 +11,8 @@ Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999
 {
 module Parser ( parseModule, parseStmt, parseIdentifier, parseIface ) where
 
+#include "HsVersions.h"
+
 import HsSyn
 import HsTypes         ( mkHsTupCon )
 
@@ -35,13 +37,12 @@ import BasicTypes   ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
                          NewOrData(..), StrictnessMark(..), Activation(..) )
 import Panic
 
-import GlaExts
+import GLAEXTS
 import CStrings                ( CLabelString )
 import FastString
 import Maybes          ( orElse )
 import Outputable
 
-#include "HsVersions.h"
 }
 
 {-

diff --git a/ghc/compiler/utils/Digraph.lhs b/ghc/compiler/utils/Digraph.lhs
index 3fb9dd4..ea3b61c 100644 (file)
--- a/ghc/compiler/utils/Digraph.lhs
+++ b/ghc/compiler/utils/Digraph.lhs
@@ -37,13 +37,19 @@ module Digraph(
 import Util    ( sortLt )
 
 -- Extensions
-import ST
+import MONAD_ST
 
 -- std interfaces
 import Maybe
 import Array
 import List
 import Outputable
+
+#if __GLASGOW_HASKELL__ >= 504
+import Data.Array.ST  hiding ( indices, bounds )
+#else
+import ST
+#endif
 \end{code}
 
 
@@ -233,6 +239,17 @@ draw (Node x ts) = grp this (space (length this)) (stLoop ts)
 %************************************************************************
 
 \begin{code}
+#if __GLASGOW_HASKELL__ >= 504
+newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)
+newSTArray = newArray
+
+readSTArray :: Ix i => STArray s i e -> i -> ST s e
+readSTArray = readArray
+
+writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s ()
+writeSTArray = writeArray
+#endif
+
 type Set s    = STArray s Vertex Bool
 
 mkEmpty      :: Bounds -> ST s (Set s)

diff --git a/ghc/compiler/utils/FastString.lhs b/ghc/compiler/utils/FastString.lhs
index d29ce9f..ea36957 100644 (file)
--- a/ghc/compiler/utils/FastString.lhs
+++ b/ghc/compiler/utils/FastString.lhs
@@ -55,7 +55,7 @@ import GHC.IOBase     ( IO(..) )
 import PrimPacked
 import GLAEXTS
 import UNSAFE_IO       ( unsafePerformIO )
-import ST              ( stToIO )
+import MONAD_ST                ( stToIO )
 import DATA_IOREF      ( IORef, newIORef, readIORef, writeIORef )
 
 #if __GLASGOW_HASKELL__ < 503

diff --git a/ghc/compiler/utils/PrimPacked.lhs b/ghc/compiler/utils/PrimPacked.lhs
index a0ee810..aa582e7 100644 (file)
--- a/ghc/compiler/utils/PrimPacked.lhs
+++ b/ghc/compiler/utils/PrimPacked.lhs
@@ -33,7 +33,7 @@ module PrimPacked (
 import GLAEXTS
 import UNSAFE_IO       ( unsafePerformIO )
 
-import ST
+import MONAD_ST
 import Foreign
 
 #if __GLASGOW_HASKELL__ < 503