Revert "cm"

This reverts commit 2e508375ad56887c8859b4de80ff43e827ac6a8f.

2 files changed, 43 insertions, 25 deletions

diff --git a/compiler/basicTypes/UniqSupply.hs b/compiler/basicTypes/UniqSupply.hs
index 9620ed4b01..8780a52208 100644
--- a/compiler/basicTypes/UniqSupply.hs
+++ b/compiler/basicTypes/UniqSupply.hs
@@ -3,7 +3,12 @@
 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 -}
 
-{-# LANGUAGE CPP, UnboxedTuples #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+#if !defined(GHC_LOADED_INTO_GHCI)
+{-# LANGUAGE UnboxedTuples #-}
+#endif
 
 module UniqSupply (
         -- * Main data type
@@ -131,22 +136,37 @@ splitUniqSupply4 us = (us1, us2, us3, us4)
 ************************************************************************
 -}
 
+-- Avoids using unboxed tuples when loading into GHCi
+#if !defined(GHC_LOADED_INTO_GHCI)
+
+type UniqResult result = (# result, UniqSupply #)
+
+pattern UniqResult :: a -> b -> (# a, b #)
+pattern UniqResult x y = (# x, y #)
+{-# COMPLETE UniqResult #-}
+
+#else
+
+data UniqResult result = UniqResult !result {-# UNPACK #-} !UniqSupply
+
+#endif
+
 -- | A monad which just gives the ability to obtain 'Unique's
-newtype UniqSM result = USM { unUSM :: UniqSupply -> (# result, UniqSupply #) }
+newtype UniqSM result = USM { unUSM :: UniqSupply -> UniqResult result }
 
 instance Monad UniqSM where
   (>>=) = thenUs
   (>>)  = (*>)
 
 instance Functor UniqSM where
-    fmap f (USM x) = USM (\us -> case x us of
-                                 (# r, us' #) -> (# f r, us' #))
+    fmap f (USM x) = USM (\us0 -> case x us0 of
+                                 UniqResult r us1 -> UniqResult (f r) us1)
 
 instance Applicative UniqSM where
     pure = returnUs
-    (USM f) <*> (USM x) = USM $ \us -> case f us of
-                            (# ff, us' #)  -> case x us' of
-                              (# xx, us'' #) -> (# ff xx, us'' #)
+    (USM f) <*> (USM x) = USM $ \us0 -> case f us0 of
+                            UniqResult ff us1 -> case x us1 of
+                              UniqResult xx us2 -> UniqResult (ff xx) us2
     (*>) = thenUs_
 
 -- TODO: try to get rid of this instance
@@ -155,11 +175,11 @@ instance Fail.MonadFail UniqSM where
 
 -- | Run the 'UniqSM' action, returning the final 'UniqSupply'
 initUs :: UniqSupply -> UniqSM a -> (a, UniqSupply)
-initUs init_us m = case unUSM m init_us of { (# r, us #) -> (r,us) }
+initUs init_us m = case unUSM m init_us of { UniqResult r us -> (r, us) }
 
 -- | Run the 'UniqSM' action, discarding the final 'UniqSupply'
 initUs_ :: UniqSupply -> UniqSM a -> a
-initUs_ init_us m = case unUSM m init_us of { (# r, _ #) -> r }
+initUs_ init_us m = case unUSM m init_us of { UniqResult r _ -> r }
 
 {-# INLINE thenUs #-}
 {-# INLINE lazyThenUs #-}
@@ -169,29 +189,29 @@ initUs_ init_us m = case unUSM m init_us of { (# r, _ #) -> r }
 -- @thenUs@ is where we split the @UniqSupply@.
 
 liftUSM :: UniqSM a -> UniqSupply -> (a, UniqSupply)
-liftUSM (USM m) us = case m us of (# a, us' #) -> (a, us')
+liftUSM (USM m) us0 = case m us0 of UniqResult a us1 -> (a, us1)
 
 instance MonadFix UniqSM where
-    mfix m = USM (\us -> let (r,us') = liftUSM (m r) us in (# r,us' #))
+    mfix m = USM (\us0 -> let (r,us1) = liftUSM (m r) us0 in UniqResult r us1)
 
 thenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b
 thenUs (USM expr) cont
-  = USM (\us -> case (expr us) of
-                   (# result, us' #) -> unUSM (cont result) us')
+  = USM (\us0 -> case (expr us0) of
+                   UniqResult result us1 -> unUSM (cont result) us1)
 
 lazyThenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b
 lazyThenUs expr cont
-  = USM (\us -> let (result, us') = liftUSM expr us in unUSM (cont result) us')
+  = USM (\us0 -> let (result, us1) = liftUSM expr us0 in unUSM (cont result) us1)
 
 thenUs_ :: UniqSM a -> UniqSM b -> UniqSM b
 thenUs_ (USM expr) (USM cont)
-  = USM (\us -> case (expr us) of { (# _, us' #) -> cont us' })
+  = USM (\us0 -> case (expr us0) of { UniqResult _ us1 -> cont us1 })
 
 returnUs :: a -> UniqSM a
-returnUs result = USM (\us -> (# result, us #))
+returnUs result = USM (\us -> UniqResult result us)
 
 getUs :: UniqSM UniqSupply
-getUs = USM (\us -> case splitUniqSupply us of (us1,us2) -> (# us1, us2 #))
+getUs = USM (\us0 -> case splitUniqSupply us0 of (us1,us2) -> UniqResult us1 us2)
 
 -- | A monad for generating unique identifiers
 class Monad m => MonadUnique m where
@@ -221,12 +241,12 @@ liftUs :: MonadUnique m => UniqSM a -> m a
 liftUs m = getUniqueSupplyM >>= return . flip initUs_ m
 
 getUniqueUs :: UniqSM Unique
-getUniqueUs = USM (\us -> case takeUniqFromSupply us of
-                          (u,us') -> (# u, us' #))
+getUniqueUs = USM (\us0 -> case takeUniqFromSupply us0 of
+                           (u,us1) -> UniqResult u us1)
 
 getUniquesUs :: UniqSM [Unique]
-getUniquesUs = USM (\us -> case splitUniqSupply us of
-                           (us1,us2) -> (# uniqsFromSupply us1, us2 #))
+getUniquesUs = USM (\us0 -> case splitUniqSupply us0 of
+                            (us1,us2) -> UniqResult (uniqsFromSupply us1) us2)
 
 -- {-# SPECIALIZE mapM          :: (a -> UniqSM b) -> [a] -> UniqSM [b] #-}
 -- {-# SPECIALIZE mapAndUnzipM  :: (a -> UniqSM (b,c))   -> [a] -> UniqSM ([b],[c]) #-}
diff --git a/hadrian/ghci.sh b/hadrian/ghci.sh
index 5a2f955e44..4c9b9c6710 100755
--- a/hadrian/ghci.sh
+++ b/hadrian/ghci.sh
@@ -2,7 +2,5 @@
 
 set -e
 
-GHC=/home/matt/ghc/m559b/stage1/bin/ghc
-GHC_FLAGS=$(TERM=dumb CABFLAGS=-v0 . "hadrian/build.cabal.sh"  tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@")
-echo $GHC_FLAGS
-/home/matt/ghc/m559b/stage1/bin/ghc --interactive -O0 $GHC_FLAGS -fwrite-interface -hidir=.hadrian_ghci/interface -O0 ghc/Main.hs
+GHC_FLAGS=$(TERM=dumb CABFLAGS=-v0 . "hadrian/build.cabal.sh" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@")
+ghci $GHC_FLAGS -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 ghc/Main.hs