diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile
index 087a3e4f775b5a87cc2c8996b2cc2584fafe311c..e94c91dac2dcc58203f21c16f538d4ed712831d1 100644
--- a/ghc/compiler/Makefile
+++ b/ghc/compiler/Makefile
@@ -1,5 +1,5 @@
 # -----------------------------------------------------------------------------
-# $Id: Makefile,v 1.64 1999/07/14 20:29:34 panne Exp $
+# $Id: Makefile,v 1.65 1999/09/17 09:11:20 simonpj Exp $
 
 TOP = ..
 include $(TOP)/mk/boilerplate.mk
@@ -150,10 +150,10 @@ prelude/PrimOp_HC_OPTS 		= -H12m -K3m
 parser/Lex_HC_OPTS		= -K2m -H16m -fvia-C
 
 # -dcore-lint is *temporary* to work around ghc space leak.
-rename/ParseIface_HC_OPTS 	+= -Onot -H45m -K2m -dcore-lint -fno-warn-incomplete-patterns -dcore-lint
+rename/ParseIface_HC_OPTS 	+= -Onot -H45m -K2m -dcore-lint -fno-warn-incomplete-patterns
 rename/ParseIface_HAPPY_OPTS    += -g
 
-parser/Parser_HC_OPTS 		+= -Onot -H80m -K2m -dcore-lint -fno-warn-incomplete-patterns -dcore-lint
+parser/Parser_HC_OPTS 		+= -Onot -H45m -K2m -dcore-lint -fno-warn-incomplete-patterns
 parser/Parser_HAPPY_OPTS    	+= -g
 
 ifeq "$(TARGETPLATFORM)" "hppa1.1-hp-hpux9"
diff --git a/ghc/compiler/basicTypes/Const.lhs b/ghc/compiler/basicTypes/Const.lhs
index 0e627c451e4976adee73b02b12f6fa9fc7f05b24..22fa7f8cefa4c3b54da684e0381137d0e6f38448 100644
--- a/ghc/compiler/basicTypes/Const.lhs
+++ b/ghc/compiler/basicTypes/Const.lhs
@@ -128,9 +128,11 @@ conIsTrivial (Literal lit) = not (isNoRepLit lit)
 conIsTrivial (PrimOp _)    = False
 conIsTrivial con	   = True
 
--- conIsCheap is true for constants whose applications we are willing
+-- conIsCheap is true for constants whose *work* we are willing
 -- to duplicate in exchange for some modest gain.  cf CoreUtils.exprIsCheap
-conIsCheap (Literal lit) = not (isNoRepLit lit)
+conIsCheap (Literal lit) = True		-- Even no-rep lits are cheap; we don't end
+					-- up duplicating their work if we push them inside
+					-- a lambda, because we float them to the top in the end
 conIsCheap (DataCon con) = True
 conIsCheap (PrimOp op)   = primOpIsCheap op
 
diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 25ff7b53e4f48cab5b2a33ffa00cc2e0b8fb8a12..11aa08dd26e9d25e0048f171370dc2d05e2b784b 100644
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -36,7 +36,7 @@ module Id (
 	isExportedId, isUserExportedId,
 
 	-- One shot lambda stuff
-	isOneShotLambda, setOneShotLambda,
+	isOneShotLambda, setOneShotLambda, clearOneShotLambda,
 
 	-- IdInfo stuff
 	setIdUnfolding,
@@ -397,4 +397,13 @@ isOneShotLambda id = case lbvarInfo (idInfo id) of
 
 setOneShotLambda :: Id -> Id
 setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
+
+clearOneShotLambda :: Id -> Id
+clearOneShotLambda id 
+  | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
+  | otherwise	       = id			
+
+-- But watch out: this may change the type of something else
+--	f = \x -> e
+-- If we change the one-shot-ness of x, f's type changes
 \end{code}
diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index ac1ef78bac4c43aba884c23471478c6120fc87df..61b3a0ec8840fcb82813d439167f1f10029744ee 100644
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -350,7 +350,8 @@ instance Outputable InlinePragInfo where
   ppr IAmALoopBreaker   	= ptext SLIT("__Ux")
   ppr IAmDead			= ptext SLIT("__Ud")
   ppr (ICanSafelyBeINLINEd InsideLam _) = ptext SLIT("__Ul")
-  ppr (ICanSafelyBeINLINEd _ _) = ptext SLIT("__Us")
+  ppr (ICanSafelyBeINLINEd NotInsideLam True)  = ptext SLIT("__Us")
+  ppr (ICanSafelyBeINLINEd NotInsideLam False) = ptext SLIT("__Us*")
 
 instance Show InlinePragInfo where
   showsPrec p prag = showsPrecSDoc p (ppr prag)
@@ -463,7 +464,7 @@ ppWorkerInfo (Just wk_id) = ptext SLIT("__P") <+> ppr wk_id
 
 noWorkerInfo = Nothing
 
-workerExists :: Maybe Id -> Bool
+workerExists :: WorkerInfo -> Bool
 workerExists = isJust
 \end{code}
 
diff --git a/ghc/compiler/utils/SST.lhs b/ghc/compiler/utils/SST.lhs
deleted file mode 100644
index 1887873793be5893762351729d21ff1d35a6bba3..0000000000000000000000000000000000000000
--- a/ghc/compiler/utils/SST.lhs
+++ /dev/null
@@ -1,251 +0,0 @@
-\section{SST: the strict state transformer monad}
-%~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-\begin{code}
-module SST(
-	SST, SST_R, FSST, FSST_R,
-
-	runSST, sstToST, stToSST, ioToSST,
-	thenSST, thenSST_, returnSST, fixSST,
-	thenFSST, thenFSST_, returnFSST, failFSST,
-	recoverFSST, recoverSST, fixFSST,
-	unsafeInterleaveSST, 
-
-	newMutVarSST, readMutVarSST, writeMutVarSST,
-	SSTRef
-  ) where
-
-#include "HsVersions.h"
-
-import GlaExts
-import ST
-
-#if __GLASGOW_HASKELL__ < 301
-import STBase		( ST(..), STret(..), StateAndPtr#(..) )
-import ArrBase		( StateAndMutableArray#(..) )
-import IOBase		( IO(..), IOResult(..) )
-#elif __GLASGOW_HASKELL__ < 400
-import PrelST		( ST(..), STret(..), StateAndPtr#(..) )
-import PrelArr		( StateAndMutableArray#(..) )
-import PrelIOBase	( IO(..), IOResult(..) )
-#else
-import PrelST		( ST(..), STret(..) )
-import PrelArr		( MutableVar(..) )
-import PrelIOBase	( IO(..) )
-#endif
-
-\end{code}
-
-@SST@ is very like the standard @ST@ monad, but it comes with its
-friend @FSST@.  Because we want the monadic bind operator to work
-for mixtures of @SST@ and @FSST@, we can't use @ST@ at all.
-
-For simplicity we don't even dress them up in newtypes.
-
-%************************************************************************
-%*									*
-\subsection{The data types}
-%*									*
-%************************************************************************
-
-\begin{code}
-type SST  s r     = State# s -> SST_R s r
-type FSST s r err = State# s -> FSST_R s r err
-
-data SST_R s r = SST_R r (State# s)
-
-data FSST_R s r err
-  = FSST_R_OK   r   (State# s)
-  | FSST_R_Fail err (State# s)
-\end{code}
-
-Converting to/from ST
-
-\begin{code}
-sstToST :: SST s r -> ST s r
-stToSST :: ST s r -> SST s r
-
-
-#if __GLASGOW_HASKELL__ < 400
-stToSST (ST st) = \ s -> case st s of STret s' r -> SST_R r s'
-sstToST sst = ST (\ s -> case sst s of SST_R r s' -> STret s' r)
-#else
-stToSST (ST st) = \ s -> case st s of (# s', r #) -> SST_R r s'
-sstToST sst = ST (\ s -> case sst s of SST_R r s' -> (# s', r #))
-#endif
-\end{code}
-
-...and IO
-
-\begin{code}
-ioToSST :: IO a -> SST RealWorld (Either IOError a)
-
-#if __GLASGOW_HASKELL__ < 400
-ioToSST (IO io)
-  = \s -> case io s of
-	    IOok   s' r   -> SST_R (Right r) s'
-	    IOfail s' err -> SST_R (Left err) s'
-#else
-
--- We should probably be using ST and exceptions instead of SST here, now
--- that GHC has exceptions and ST is strict.
-
-ioToSST io
-  = \s -> case catch (io >>= return . Right) (return . Left) of { IO m ->
-	  case m s of {
-		(# s', r #) -> SST_R r s'
-	  } }
-#endif
-
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{The @SST@ operations}
-%*									*
-%************************************************************************
-
-\begin{code}
--- Type of runSST should be builtin ...
--- runSST :: forall r. (forall s. SST s r) -> r
-
-runSST :: SST RealWorld r  -> r
-runSST m = case m realWorld# of SST_R r s -> r
-
-unsafeInterleaveSST :: SST s r -> SST s r
-unsafeInterleaveSST m s = SST_R r s		-- Duplicates the state!
-			where
-			  SST_R r _ = m s
-
-returnSST :: r -> SST s r
-fixSST    :: (r -> SST s r) -> SST s r
-{-# INLINE returnSST #-}
-{-# INLINE thenSST #-}
-{-# INLINE thenSST_ #-}
-
-returnSST r s = SST_R r s
-
-fixSST m s = result
-	   where
-	     result 	  = m loop s
-	     SST_R loop _ = result
-\end{code}
-
-OK, here comes the clever bind operator.
-
-\begin{code}
-thenSST   :: SST s r -> (r -> State# s -> b) -> State# s -> b
-thenSST_  :: SST s r -> (State# s -> b) -> State# s -> b
--- Hence:
---	thenSST :: SST s r -> (r -> SST  s r')     -> SST  s r'
--- and  thenSST :: SST s r -> (r -> FSST s r' err) -> FSST s r' err
-
--- Hence:
---	thenSST_ :: SST s r -> SST  s r'     -> SST  s r'
--- and  thenSST_ :: SST s r -> FSST s r' err -> FSST s r' err
-
-thenSST  m k s = case m s of { SST_R r s' -> k r s' }
-
-thenSST_ m k s = case m s of { SST_R r s' -> k s' }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{FSST: the failable strict state transformer monad}
-%*									*
-%************************************************************************
-
-\begin{code}
-failFSST    :: err -> FSST s r err
-fixFSST     :: (r -> FSST s r err) -> FSST s r err
-recoverFSST :: (err -> FSST s r err) -> FSST s r err -> FSST s r err
-recoverSST  :: (err -> SST s r) -> FSST s r err -> SST s r
-returnFSST  :: r -> FSST s r err
-thenFSST    :: FSST s r err -> (r -> FSST s r' err) -> FSST s r' err
-thenFSST_   :: FSST s r err -> FSST s r' err -> FSST s r' err
-{-# INLINE failFSST #-}
-{-# INLINE returnFSST #-}
-{-# INLINE thenFSST #-}
-{-# INLINE thenFSST_ #-}
-
-thenFSST m k s = case m s of
-		   FSST_R_OK r s'     -> k r s'
-		   FSST_R_Fail err s' -> FSST_R_Fail err s'
-
-thenFSST_ m k s = case m s of
-		    FSST_R_OK r s'     -> k s'
-		    FSST_R_Fail err s' -> FSST_R_Fail err s'
-
-returnFSST r s = FSST_R_OK r s
-
-failFSST err s = FSST_R_Fail err s
-
-recoverFSST recovery_fn m s
-  = case m s of 
-	FSST_R_OK r s'     -> FSST_R_OK r s'
-	FSST_R_Fail err s' -> recovery_fn err s'
-
-recoverSST recovery_fn m s
-  = case m s of 
-	FSST_R_OK r s'     -> SST_R r s'
-	FSST_R_Fail err s' -> recovery_fn err s'
-
-fixFSST m s = result
-	    where
-	      result 	       = m loop s
-	      FSST_R_OK loop _ = result
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Mutables}
-%*									*
-%************************************************************************
-
-Here we implement mutable variables.
-
-\begin{code}
-#if __GLASGOW_HASKELL__ < 400
-type SSTRef s a = MutableArray s Int a
-#else
-type SSTRef s a = MutableVar s a
-#endif
-
-newMutVarSST   :: a -> SST s (SSTRef s a)
-readMutVarSST  :: SSTRef s a -> SST s a
-writeMutVarSST :: SSTRef s a -> a -> SST s ()
-
-#if __GLASGOW_HASKELL__ < 400
-
-newMutVarSST init s#
-  = case (newArray# 1# init s#)     of { StateAndMutableArray# s2# arr# ->
-    SST_R (MutableArray vAR_IXS arr#) s2# }
-  where
-    vAR_IXS = error "Shouldn't access `bounds' of a MutableVar\n"
-
-readMutVarSST (MutableArray _ var#) s#
-  = case readArray# var# 0# s#	of { StateAndPtr# s2# r ->
-    SST_R r s2# }
-
-writeMutVarSST (MutableArray _ var#) val s#
-  = case writeArray# var# 0# val s# of { s2# ->
-    SST_R () s2# }
-
-#else
-
-newMutVarSST init s#
-  = case (newMutVar# init s#) of { (# s2#, var# #) ->
-    SST_R (MutableVar var#) s2# }
-
-readMutVarSST (MutableVar var#) s#
-  = case readMutVar# var# s#	of { (# s2#, r #) ->
-    SST_R r s2# }
-
-writeMutVarSST (MutableVar var#) val s#
-  = case writeMutVar# var# val s# of { s2# ->
-    SST_R () s2# }
-
-#endif
-\end{code}
-