[project @ 2003-09-16 13:03:37 by simonmar]

Legacy Removal ~~~~~~~~~~~~~~ The following features have been consigned to the bit bucket: _ccall_ _casm_ ``....'' (lit-lits) the CCallable class the CReturnable class
author: simonmar <unknown> 2003-09-16 13:03:49 +0000
committer: simonmar <unknown> 2003-09-16 13:03:49 +0000
commit: 2129fa6fc4afd7f7b0c767f8c0c14b9ab5508ec2 (patch)
tree: c4d6d2888c582f17f46dedc88678bb7ec0f1e364
parent: ce42f19f8c840fbe89844471a0d850d310a94556 (diff)
download: haskell-2129fa6fc4afd7f7b0c767f8c0c14b9ab5508ec2.tar.gz
40 files changed, 63 insertions, 500 deletions
diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs
index 893f88a5f6..7dfd8ee4a7 100644
--- a/ghc/compiler/absCSyn/AbsCUtils.lhs
+++ b/ghc/compiler/absCSyn/AbsCUtils.lhs
@@ -31,8 +31,7 @@ import Unique		( Unique{-instance Eq-} )
 import UniqSupply	( uniqFromSupply, uniqsFromSupply, splitUniqSupply, 
 			  UniqSupply )
 import CmdLineOpts      ( opt_EmitCExternDecls, opt_Unregisterised )
-import ForeignCall	( ForeignCall(..), CCallSpec(..),
-			  isDynamicTarget, isCasmTarget )
+import ForeignCall	( ForeignCall(..), CCallSpec(..), isDynamicTarget )
 import StgSyn		( StgOp(..) )
 import CoreSyn		( AltCon(..) )
 import SMRep		( arrPtrsHdrSize, arrWordsHdrSize, fixedHdrSize )
@@ -343,8 +342,8 @@ flatAbsC (CSwitch discrim alts deflt)
 	returnFlt ( (tag, alt_heres), alt_tops )
 
 flatAbsC stmt@(COpStmt results (StgFCallOp (CCall ccall@(CCallSpec target _ _)) uniq) args _)
-  |  is_dynamic	 			 -- Emit a typedef if its a dynamic call
-     || (opt_EmitCExternDecls && not (isCasmTarget target)) -- or we want extern decls
+  |  is_dynamic	 	       -- Emit a typedef if its a dynamic call
+     || (opt_EmitCExternDecls) -- or we want extern decls
   = returnFlt (stmt, CCallTypedef is_dynamic ccall uniq results args)
   where
     is_dynamic = isDynamicTarget target
diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs
index f7b3118264..bea6d67193 100644
--- a/ghc/compiler/absCSyn/PprAbsC.lhs
+++ b/ghc/compiler/absCSyn/PprAbsC.lhs
@@ -949,7 +949,6 @@ pprFCall call uniq args results vol_regs
 
     call_str tgt 
       = case tgt of
-	  CasmTarget str  -> unpackFS str
   	  StaticTarget fn -> mk_ccall_str (pprCLabelString fn) ccall_args
 	  DynamicTarget   -> mk_ccall_str dyn_fun	       (tail ccall_args)
 
diff --git a/ghc/compiler/basicTypes/Literal.lhs b/ghc/compiler/basicTypes/Literal.lhs
index 1e39e65a55..d71bedf7fd 100644
--- a/ghc/compiler/basicTypes/Literal.lhs
+++ b/ghc/compiler/basicTypes/Literal.lhs
@@ -8,7 +8,7 @@ module Literal
 	( Literal(..)		-- Exported to ParseIface
 	, mkMachInt, mkMachWord
 	, mkMachInt64, mkMachWord64
-	, isLitLitLit, maybeLitLit, litSize
+	, litSize
 	, litIsDupable, litIsTrivial
 	, literalType, literalPrimRep
 	, hashLiteral
@@ -123,16 +123,9 @@ data Literal
 					-- 'stdcall' labels.
 					-- Just x => "@<x>" will be appended to label
 					--           name when emitting asm.
-
-	-- lit-lits only work for via-C compilation, hence they
-	-- are deprecated.  The string is emitted verbatim into
-	-- the C file, and can therefore be any C expression,
-	-- macro call, #defined constant etc.
-  | MachLitLit  FastString Type	-- Type might be Addr# or Int# etc
 \end{code}
 
-Binary instance: must do this manually, because we don't want the type
-arg of MachLitLit involved.
+Binary instance
 
 \begin{code}
 instance Binary Literal where
@@ -146,7 +139,6 @@ instance Binary Literal where
     put_ bh (MachFloat ah)    = do putByte bh 7; put_ bh ah
     put_ bh (MachDouble ai)   = do putByte bh 8; put_ bh ai
     put_ bh (MachLabel aj mb) = do putByte bh 9; put_ bh aj ; put_ bh mb
-    put_ bh (MachLitLit ak _) = do putByte bh 10; put_ bh ak
     get bh = do
 	    h <- getByte bh
 	    case h of
@@ -180,9 +172,6 @@ instance Binary Literal where
 		    aj <- get bh
 		    mb <- get bh
 		    return (MachLabel aj mb)
-	      10 -> do
-		    ak <- get bh
-		    return (MachLitLit ak (error "MachLitLit: no type"))
 \end{code}
 
 \begin{code}
@@ -283,12 +272,6 @@ nullAddrLit = MachNullAddr
 	Predicates
 	~~~~~~~~~~
 \begin{code}
-isLitLitLit (MachLitLit _ _) = True
-isLitLitLit _	    	     = False
-
-maybeLitLit (MachLitLit s t) = Just (s,t)
-maybeLitLit _		     = Nothing
-
 litIsTrivial :: Literal -> Bool
 -- True if there is absolutely no penalty to duplicating the literal
 --	c.f. CoreUtils.exprIsTrivial
@@ -326,7 +309,6 @@ literalType (MachWord64  _)	  = word64PrimTy
 literalType (MachFloat _)	  = floatPrimTy
 literalType (MachDouble _)	  = doublePrimTy
 literalType (MachLabel _ _)	  = addrPrimTy
-literalType (MachLitLit _ ty)	  = ty
 \end{code}
 
 \begin{code}
@@ -342,7 +324,6 @@ literalPrimRep (MachWord64 _)	  = Word64Rep
 literalPrimRep (MachFloat _)	  = FloatRep
 literalPrimRep (MachDouble _)	  = DoubleRep
 literalPrimRep (MachLabel _ _)	  = AddrRep
-literalPrimRep (MachLitLit _ ty)  = typePrimRep ty
 \end{code}
 
 
@@ -359,7 +340,6 @@ cmpLit (MachWord64    a)   (MachWord64	   b)   = a `compare` b
 cmpLit (MachFloat     a)   (MachFloat	   b)   = a `compare` b
 cmpLit (MachDouble    a)   (MachDouble	   b)   = a `compare` b
 cmpLit (MachLabel     a _) (MachLabel      b _) = a `compare` b
-cmpLit (MachLitLit    a b) (MachLitLit    c d)  = (a `compare` c) `thenCmp` (b `tcCmpType` d)
 cmpLit lit1		   lit2		        | litTag lit1 <# litTag lit2 = LT
 					        | otherwise  		       = GT
 
@@ -373,7 +353,6 @@ litTag (MachWord64    _)   = _ILIT(7)
 litTag (MachFloat     _)   = _ILIT(8)
 litTag (MachDouble    _)   = _ILIT(9)
 litTag (MachLabel   _ _)   = _ILIT(10)
-litTag (MachLitLit  _ _)   = _ILIT(11)
 \end{code}
 
 	Printing
@@ -426,11 +405,6 @@ pprLit lit
 	       Nothing -> pprHsString l
 	       Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
 
-      MachLitLit s ty | code_style  -> ftext s
-		      | otherwise   -> parens (hsep [ptext SLIT("__litlit"), 
-						     pprHsString s,
-						     pprParendType ty])
-
 -- negative floating literals in code style need parentheses to avoid
 -- interacting with surrounding syntax.
 code_rational d | d < 0     = parens (rational d)
@@ -476,7 +450,6 @@ hashLiteral (MachWord64 i) 	= hashInteger i
 hashLiteral (MachFloat r)   	= hashRational r
 hashLiteral (MachDouble r)  	= hashRational r
 hashLiteral (MachLabel s _)     = hashFS s
-hashLiteral (MachLitLit s _)    = hashFS s
 
 hashRational :: Rational -> Int
 hashRational r = hashInteger (numerator r)
diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs
index c83a03527a..6752a3b79b 100644
--- a/ghc/compiler/codeGen/CgCon.lhs
+++ b/ghc/compiler/codeGen/CgCon.lhs
@@ -68,7 +68,7 @@ cgTopRhsCon :: Id		-- Name of thing bound to this RHS
 	    -> [StgArg]		-- Args
 	    -> FCode (Id, CgIdInfo)
 cgTopRhsCon id con args
-  = ASSERT( not (isDllConApp con args) )	-- checks for litlit args too
+  = ASSERT( not (isDllConApp con args) )
     ASSERT( args `lengthIs` dataConRepArity con )
 
 	-- LAY IT OUT
diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
index 46f2ba2015..01d7925741 100644
--- a/ghc/compiler/coreSyn/CoreUnfold.lhs
+++ b/ghc/compiler/coreSyn/CoreUnfold.lhs
@@ -24,7 +24,6 @@ module CoreUnfold (
 
 	couldBeSmallEnoughToInline, 
 	certainlyWillInline, 
-	okToUnfoldInHiFile,
 
 	callSiteInline
     ) where
@@ -35,7 +34,7 @@ import CmdLineOpts	( opt_UF_CreationThreshold,
 			  opt_UF_UseThreshold,
 			  opt_UF_FunAppDiscount,
 		  	  opt_UF_KeenessFactor,
-			  opt_UF_DearOp, opt_UnfoldCasms,
+			  opt_UF_DearOp,
 			  DynFlags, DynFlag(..), dopt
 			)
 import CoreSyn
@@ -47,9 +46,8 @@ import Id		( Id, idType, isId,
 			  isFCallId_maybe, globalIdDetails
 			)
 import DataCon		( isUnboxedTupleCon )
-import Literal		( isLitLitLit, litSize )
+import Literal		( litSize )
 import PrimOp		( primOpIsDupable, primOpOutOfLine )
-import ForeignCall	( okToExposeFCall )
 import IdInfo		( OccInfo(..), GlobalIdDetails(..) )
 import Type		( isUnLiftedType )
 import PrelNames	( hasKey, buildIdKey, augmentIdKey )
@@ -467,36 +465,6 @@ certainlyWillInline other
   = False
 \end{code}
 
-@okToUnfoldInHifile@ is used when emitting unfolding info into an interface
-file to determine whether an unfolding candidate really should be unfolded.
-The predicate is needed to prevent @_casm_@s (+ lit-lits) from being emitted
-into interface files. 
-
-The reason for inlining expressions containing _casm_s into interface files
-is that these fragments of C are likely to mention functions/#defines that
-will be out-of-scope when inlined into another module. This is not an
-unfixable problem for the user (just need to -#include the approp. header
-file), but turning it off seems to the simplest thing to do.
-
-\begin{code}
-okToUnfoldInHiFile :: CoreExpr -> Bool
-okToUnfoldInHiFile e = opt_UnfoldCasms || go e
- where
-    -- Race over an expression looking for CCalls..
-    go (Var v)                = case isFCallId_maybe v of
-				  Just fcall -> okToExposeFCall fcall
-				  Nothing    -> True
-    go (Lit lit)	      = not (isLitLitLit lit)
-    go (App fun arg)          = go fun && go arg
-    go (Lam _ body)           = go body
-    go (Let binds body)       = and (map go (body :rhssOfBind binds))
-    go (Case scrut bndr alts) = and (map go (scrut:rhssOfAlts alts)) &&
-				not (any isLitLitLit [ lit | (LitAlt lit, _, _) <- alts ])
-    go (Note _ body)          = go body
-    go (Type _)		      = True
-\end{code}
-
-
 %************************************************************************
 %*									*
 \subsection{callSiteInline}
diff --git a/ghc/compiler/coreSyn/CoreUtils.lhs b/ghc/compiler/coreSyn/CoreUtils.lhs
index 882d469ef3..7921b3cfcf 100644
--- a/ghc/compiler/coreSyn/CoreUtils.lhs
+++ b/ghc/compiler/coreSyn/CoreUtils.lhs
@@ -45,7 +45,7 @@ import Var		( Var, isId, isTyVar )
 import VarEnv
 import Name		( hashName, isDllName )
 import Literal		( hashLiteral, literalType, litIsDupable, 
-			  litIsTrivial, isZeroLit, isLitLitLit )
+			  litIsTrivial, isZeroLit )
 import DataCon		( DataCon, dataConRepArity, dataConArgTys,
 			  isExistentialDataCon, dataConTyCon, dataConName )
 import PrimOp		( PrimOp(..), primOpOkForSpeculation, primOpIsCheap )
@@ -1157,11 +1157,10 @@ hashId id = hashName (idName id)
 %*									*
 %************************************************************************
 
-Top-level constructor applications can usually be allocated 
-statically, but they can't if 
-   a) the constructor, or any of the arguments, come from another DLL
-   b) any of the arguments are LitLits
-(because we can't refer to static labels in other DLLs).
+Top-level constructor applications can usually be allocated
+statically, but they can't if the constructor, or any of the
+arguments, come from another DLL (because we can't refer to static
+labels in other DLLs).
 
 If this happens we simply make the RHS into an updatable thunk, 
 and 'exectute' it rather than allocating it statically.
@@ -1235,10 +1234,7 @@ is_static False (Lam b e) = isRuntimeVar b || is_static False e
 
 is_static in_arg (Note (SCC _) e) = False
 is_static in_arg (Note _ e)       = is_static in_arg e
-
-is_static in_arg (Lit lit)        = not (isLitLitLit lit)
-	-- lit-lit arguments cannot be used in static constructors either.  
-	-- (litlits are deprecated, so I'm not going to bother cleaning up this infelicity --SDM).
+is_static in_arg (Lit lit)        = True
 
 is_static in_arg other_expr = go other_expr 0
   where
diff --git a/ghc/compiler/deSugar/DsCCall.lhs b/ghc/compiler/deSugar/DsCCall.lhs
index f2fdc288f5..71f3324adf 100644
--- a/ghc/compiler/deSugar/DsCCall.lhs
+++ b/ghc/compiler/deSugar/DsCCall.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The AQUA Project, Glasgow University, 1994-1998
 %
-\section[DsCCall]{Desugaring \tr{_ccall_}s and \tr{_casm_}s}
+\section[DsCCall]{Desugaring C calls}
 
 \begin{code}
 module DsCCall 
@@ -103,17 +103,15 @@ follows:
 dsCCall :: CLabelString	-- C routine to invoke
 	-> [CoreExpr]	-- Arguments (desugared)
 	-> Safety	-- Safety of the call
-	-> Bool		-- True <=> really a "_casm_"
 	-> Type		-- Type of the result: IO t
 	-> DsM CoreExpr
 
-dsCCall lbl args may_gc is_asm result_ty
+dsCCall lbl args may_gc result_ty
   = mapAndUnzipDs unboxArg args	       `thenDs` \ (unboxed_args, arg_wrappers) ->
     boxResult [] id Nothing result_ty  `thenDs` \ (ccall_result_ty, res_wrapper) ->
     getUniqueDs			       `thenDs` \ uniq ->
     let
-	target | is_asm    = CasmTarget lbl
-	       | otherwise = StaticTarget lbl
+	target = StaticTarget lbl
 	the_fcall    = CCall (CCallSpec target CCallConv may_gc)
  	the_prim_app = mkFCall uniq the_fcall unboxed_args ccall_result_ty
     in
diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs
index 6ef07ffee9..bed0a6fd4d 100644
--- a/ghc/compiler/deSugar/DsExpr.lhs
+++ b/ghc/compiler/deSugar/DsExpr.lhs
@@ -236,11 +236,6 @@ dsExpr (SectionR op expr)
     returnDs (bindNonRec y_id y_core $
 	      Lam x_id (mkApps core_op [Var x_id, Var y_id]))
 
-dsExpr (HsCCall lbl args may_gc is_asm result_ty)
-  = mapDs dsExpr args		`thenDs` \ core_args ->
-    dsCCall lbl core_args may_gc is_asm result_ty
-	-- dsCCall does all the unboxification, etc.
-
 dsExpr (HsSCC cc expr)
   = dsExpr expr			`thenDs` \ core_expr ->
     getModuleDs			`thenDs` \ mod_name ->
diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs
index 4f34d4c9ee..22c8569aae 100644
--- a/ghc/compiler/deSugar/DsForeign.lhs
+++ b/ghc/compiler/deSugar/DsForeign.lhs
@@ -391,7 +391,7 @@ dsFExportDynamic id cconv
 		      StdCallConv -> Just sz_args
 		      _ 	  -> Nothing
      in
-     dsCCall adjustor adj_args PlayRisky False io_res_ty	`thenDs` \ ccall_adj ->
+     dsCCall adjustor adj_args PlayRisky io_res_ty	`thenDs` \ ccall_adj ->
 	-- PlayRisky: the adjustor doesn't allocate in the Haskell heap or do a callback
      let ccall_adj_ty = exprType ccall_adj
          ccall_io_adj = mkLams [stbl_value]		     $
diff --git a/ghc/compiler/deSugar/DsMeta.hs b/ghc/compiler/deSugar/DsMeta.hs
index b02761cdad..4b179f5224 100644
--- a/ghc/compiler/deSugar/DsMeta.hs
+++ b/ghc/compiler/deSugar/DsMeta.hs
@@ -525,7 +525,6 @@ repE (ArithSeqIn aseq) =
 			     repFromThenTo ds1 ds2 ds3
 repE (PArrSeqOut _ aseq)  = panic "DsMeta.repE: parallel array seq.s missing"
 repE (HsCoreAnn _ _)      = panic "DsMeta.repE: Can't represent CoreAnn" -- hdaume: core annotations
-repE (HsCCall _ _ _ _ _)  = panic "DsMeta.repE: Can't represent __ccall__"
 repE (HsSCC _ _)          = panic "DsMeta.repE: Can't represent SCC"
 repE (HsBracketOut _ _)   = 
   panic "DsMeta.repE: Can't represent Oxford brackets"
diff --git a/ghc/compiler/deSugar/MatchLit.lhs b/ghc/compiler/deSugar/MatchLit.lhs
index 01d1ed8c40..2be6e259d6 100644
--- a/ghc/compiler/deSugar/MatchLit.lhs
+++ b/ghc/compiler/deSugar/MatchLit.lhs
@@ -12,7 +12,6 @@ import {-# SOURCE #-} Match  ( match )
 import {-# SOURCE #-} DsExpr ( dsExpr )
 
 import DsMonad
-import DsCCall		( resultWrapper )
 import DsUtils
 
 import HsSyn		( HsLit(..), Pat(..), HsExpr(..) )
@@ -26,9 +25,7 @@ import PrelNames	( ratioTyConKey )
 import Unique		( hasKey )
 import Literal		( mkMachInt, Literal(..) )
 import Maybes		( catMaybes )
-import Type		( isUnLiftedType )
 import Panic		( panic, assertPanic )
-import Maybe		( isJust )
 import Ratio 		( numerator, denominator )
 \end{code}
 
@@ -64,11 +61,6 @@ dsLit (HsInt i)	       = returnDs (mkIntExpr i)
 dsLit (HsIntPrim i)    = returnDs (mkIntLit i)
 dsLit (HsFloatPrim f)  = returnDs (mkLit (MachFloat f))
 dsLit (HsDoublePrim d) = returnDs (mkLit (MachDouble d))
-dsLit (HsLitLit str ty)
-  = resultWrapper ty `thenDs` \ (maybe_ty, wrap_fn) ->
-    ASSERT( isJust maybe_ty )
-      let (Just rep_ty) = maybe_ty in 
-      returnDs (wrap_fn (mkLit (MachLitLit str rep_ty)))
 
 dsLit (HsRat r ty)
   = mkIntegerExpr (numerator r)		`thenDs` \ num ->
@@ -133,8 +125,6 @@ matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo n ctx (LitPat literal : ps1
 	mk_core_lit (HsStringPrim  s) 	 = MachStr    s
 	mk_core_lit (HsFloatPrim   f) 	 = MachFloat  f
 	mk_core_lit (HsDoublePrim  d)    = MachDouble d
-	mk_core_lit (HsLitLit      s ty) = ASSERT(isUnLiftedType ty)
-		    		           MachLitLit s ty
     	mk_core_lit other	         = panic "matchLiterals:mk_core_lit:unhandled"
 \end{code}
 
diff --git a/ghc/compiler/hsSyn/HsCore.lhs b/ghc/compiler/hsSyn/HsCore.lhs
index 27b6ae606c..cc0c27bb1d 100644
--- a/ghc/compiler/hsSyn/HsCore.lhs
+++ b/ghc/compiler/hsSyn/HsCore.lhs
@@ -39,7 +39,7 @@ import RdrName		( RdrName, rdrNameOcc )
 import CoreSyn
 import CostCentre	( pprCostCentreCore )
 import NewDemand	( StrictSig, pprIfaceStrictSig )
-import Literal		( Literal, maybeLitLit )
+import Literal		( Literal )
 import ForeignCall	( ForeignCall )
 import DataCon		( dataConTyCon, dataConSourceArity )
 import TyCon		( isTupleTyCon, tupleTyConBoxity )
@@ -69,7 +69,6 @@ data UfExpr name
   | UfLet	(UfBinding name)  (UfExpr name)
   | UfNote	(UfNote name) (UfExpr name)
   | UfLit	Literal
-  | UfLitLit	FastString (HsType name)
   | UfFCall	ForeignCall (HsType name)
 
 data UfNote name = UfSCC CostCentre
@@ -84,7 +83,6 @@ data UfConAlt name = UfDefault
  		   | UfDataAlt name
 		   | UfTupleAlt HsTupCon
 		   | UfLitAlt Literal
-		   | UfLitLitAlt FastString (HsType name)
 
 data UfBinding name
   = UfNonRec	(UfBinder name)
@@ -110,9 +108,7 @@ ufBinderName (UfTyBinder  n _) = n
 \begin{code}
 toUfExpr :: CoreExpr -> UfExpr Name
 toUfExpr (Var v) = toUfVar v
-toUfExpr (Lit l) = case maybeLitLit l of
-			Just (s,ty) -> UfLitLit s (toHsType ty)
-			Nothing     -> UfLit l
+toUfExpr (Lit l) = UfLit l
 toUfExpr (Type ty) = UfType (toHsType ty)
 toUfExpr (Lam x b) = UfLam (toUfBndr x) (toUfExpr b)
 toUfExpr (App f a) = toUfApp f [a]
@@ -140,9 +136,7 @@ toUfCon (DataAlt dc) | isTupleTyCon tc = UfTupleAlt (mk_hs_tup_con tc dc)
 		     where
 		       tc = dataConTyCon dc
 
-toUfCon (LitAlt l)   = case maybeLitLit l of
-			 Just (s,ty) -> UfLitLitAlt s (toHsType ty)
-			 Nothing     -> UfLitAlt l
+toUfCon (LitAlt l)   = UfLitAlt l
 toUfCon DEFAULT	     = UfDefault
 
 ---------------------
@@ -207,7 +201,6 @@ pprUfExpr :: OutputableBndr name => (SDoc -> SDoc) -> UfExpr name -> SDoc
 
 pprUfExpr add_par (UfVar v)       = ppr v
 pprUfExpr add_par (UfLit l)       = ppr l
-pprUfExpr add_par (UfLitLit l ty) = add_par (hsep [ptext SLIT("__litlit"), pprHsString l, pprParendHsType ty])
 pprUfExpr add_par (UfFCall cc ty) = braces (ppr cc <+> ppr ty)
 pprUfExpr add_par (UfType ty)     = char '@' <+> pprParendHsType ty
 
@@ -259,7 +252,6 @@ instance Outputable name => Outputable (UfNote name) where
 instance Outputable name => Outputable (UfConAlt name) where
     ppr UfDefault	   = text "__DEFAULT"
     ppr (UfLitAlt l)       = ppr l
-    ppr (UfLitLitAlt l ty) = parens (hsep [ptext SLIT("__litlit"), pprHsString l, pprParendHsType ty])
     ppr (UfDataAlt d)	   = ppr d
 
 instance Outputable name => Outputable (UfBinder name) where
@@ -326,7 +318,6 @@ eq_ufVar env n1 n2 = case lookupFM env n1 of
 eq_ufExpr :: (NamedThing name, Ord name) => EqHsEnv name -> UfExpr name -> UfExpr name -> Bool
 eq_ufExpr env (UfVar v1)	(UfVar v2)	  = eq_ufVar env v1 v2
 eq_ufExpr env (UfLit l1)        (UfLit l2) 	  = l1 == l2
-eq_ufExpr env (UfLitLit l1 ty1) (UfLitLit l2 ty2) = l1==l2 && eq_hsType env ty1 ty2
 eq_ufExpr env (UfFCall c1 ty1)  (UfFCall c2 ty2)  = c1==c2 && eq_hsType env ty1 ty2
 eq_ufExpr env (UfType ty1)      (UfType ty2)	  = eq_hsType env ty1 ty2
 eq_ufExpr env (UfTuple n1 as1)  (UfTuple n2 as2)  = n1==n2 && eqListBy (eq_ufExpr env) as1 as2
@@ -366,7 +357,6 @@ eq_ufConAlt env UfDefault	    UfDefault		= True
 eq_ufConAlt env (UfDataAlt n1)	    (UfDataAlt n2)	= n1==n2
 eq_ufConAlt env (UfTupleAlt c1)	    (UfTupleAlt c2)	= c1==c2
 eq_ufConAlt env (UfLitAlt l1)	    (UfLitAlt l2)	= l1==l2
-eq_ufConAlt env (UfLitLitAlt s1 t1) (UfLitLitAlt s2 t2) = s1==s2 && eq_hsType env t1 t2
 eq_ufConAlt env _ _ = False
 \end{code}
 
diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs
index 001d4f8ada..d5e9c07f13 100644
--- a/ghc/compiler/hsSyn/HsDecls.lhs
+++ b/ghc/compiler/hsSyn/HsDecls.lhs
@@ -794,8 +794,6 @@ instance Outputable ForeignImport where
 	pprLib lib <> ppr lbl
       pprCEntity header lib (CFunction (DynamicTarget)) = 
         ptext SLIT("dynamic")
-      pprCEntity header lib (CFunction (CasmTarget _)) = 
-        panic "HsDecls.pprCEntity: malformed C function target"
       pprCEntity _      _   (CWrapper) = ptext SLIT("wrapper")
       --
       pprLib lib | nullFastString lib = empty
diff --git a/ghc/compiler/hsSyn/HsExpr.lhs b/ghc/compiler/hsSyn/HsExpr.lhs
index cf6b424303..9b2b64fc87 100644
--- a/ghc/compiler/hsSyn/HsExpr.lhs
+++ b/ghc/compiler/hsSyn/HsExpr.lhs
@@ -17,14 +17,11 @@ import HsTypes		( HsType, PostTcType, SyntaxName )
 import HsImpExp		( isOperator, pprHsVar )
 
 -- others:
-import ForeignCall	( Safety )
 import PprType		( pprParendType )
 import Type		( Type )
 import Var		( TyVar, Id )
 import Name		( Name )
-import NameSet		( FreeVars )
 import DataCon		( DataCon )
-import CStrings		( CLabelString, pprCLabelString )
 import BasicTypes	( IPName, Boxity, tupleParens, Fixity(..) )
 import SrcLoc		( SrcLoc )
 import Outputable	
@@ -141,19 +138,6 @@ data HsExpr id
 		(HsExpr id)		-- (typechecked, of course)
 		(ArithSeqInfo id)
 
-  | HsCCall	CLabelString	-- call into the C world; string is
-		[HsExpr id]	-- the C function; exprs are the
-				-- arguments to pass.
-		Safety		-- True <=> might cause Haskell
-				-- garbage-collection (must generate
-				-- more paranoid code)
-		Bool		-- True <=> it's really a "casm"
-				-- NOTE: this CCall is the *boxed*
-				-- version; the desugarer will convert
-				-- it into the unboxed "ccall#".
-		PostTcType	-- The result type; will be *bottom*
-				-- until the typechecker gets ahold of it
-
   | HsSCC	FastString	-- "set cost centre" (_scc_) annotation
 		(HsExpr id) 	-- expr whose cost is to be measured
 
@@ -390,12 +374,6 @@ ppr_expr EWildPat = char '_'
 ppr_expr (ELazyPat e) = char '~' <> pprParendExpr e
 ppr_expr (EAsPat v e) = ppr v <> char '@' <> pprParendExpr e
 
-ppr_expr (HsCCall fun args _ is_asm result_ty)
-  = hang (if is_asm
-	  then ptext SLIT("_casm_ ``") <> pprCLabelString fun <> ptext SLIT("''")
-	  else ptext SLIT("_ccall_") <+> pprCLabelString fun)
-       4 (sep (map pprParendExpr args))
-
 ppr_expr (HsSCC lbl expr)
   = sep [ ptext SLIT("_scc_") <+> doubleQuotes (ftext lbl), pprParendExpr expr ]
 
diff --git a/ghc/compiler/hsSyn/HsLit.lhs b/ghc/compiler/hsSyn/HsLit.lhs
index 0d9009829b..8eb18e278e 100644
--- a/ghc/compiler/hsSyn/HsLit.lhs
+++ b/ghc/compiler/hsSyn/HsLit.lhs
@@ -38,11 +38,6 @@ data HsLit
 					-- 	(overloaded literals are done with HsOverLit)
   | HsFloatPrim	    Rational		-- Unboxed Float
   | HsDoublePrim    Rational		-- Unboxed Double
-  | HsLitLit	    FastString PostTcType	-- to pass ``literal literals'' through to C
-						-- also: "overloaded" type; but
-						-- must resolve to boxed-primitive!
-	-- The Type in HsLitLit is needed when desuaring;
-	-- before the typechecker it's just an error value
 
 instance Eq HsLit where
   (HsChar x1)	    == (HsChar x2)	 = x1==x2
@@ -55,7 +50,6 @@ instance Eq HsLit where
   (HsRat x1 _)	    == (HsRat x2 _)      = x1==x2
   (HsFloatPrim x1)  == (HsFloatPrim x2)  = x1==x2
   (HsDoublePrim x1) == (HsDoublePrim x2) = x1==x2
-  (HsLitLit x1 _)   == (HsLitLit x2 _)   = x1==x2
   lit1		    == lit2		 = False
 
 data HsOverLit 			-- An overloaded literal
@@ -88,11 +82,8 @@ instance Outputable HsLit where
     ppr (HsFloatPrim f)	 = rational f <> char '#'
     ppr (HsDoublePrim d) = rational d <> text "##"
     ppr (HsIntPrim i)	 = integer i  <> char '#'
-    ppr (HsLitLit s _)	 = hcat [text "``", ftext s, text "''"]
 
 instance Outputable HsOverLit where
   ppr (HsIntegral i _)   = integer i
   ppr (HsFractional f _) = rational f
 \end{code}
-
-
diff --git a/ghc/compiler/main/BinIface.hs b/ghc/compiler/main/BinIface.hs
index e489fb2ed2..a2c8249263 100644
--- a/ghc/compiler/main/BinIface.hs
+++ b/ghc/compiler/main/BinIface.hs
@@ -788,12 +788,8 @@ instance (Binary name) => Binary (UfExpr name) where
     put_ bh (UfLit ap) = do
 	    putByte bh 8
 	    put_ bh ap
-    put_ bh (UfLitLit aq ar) = do
-	    putByte bh 9
-	    put_ bh aq
-	    put_ bh ar
     put_ bh (UfFCall as at) = do
-	    putByte bh 10
+	    putByte bh 9
 	    put_ bh as
 	    put_ bh at
     get bh = do
@@ -824,9 +820,6 @@ instance (Binary name) => Binary (UfExpr name) where
 		      return (UfNote an ao)
 	      8 -> do ap <- get bh
 		      return (UfLit ap)
-	      9 -> do aq <- get bh
-		      ar <- get bh
-		      return (UfLitLit aq ar)
 	      _ -> do as <- get bh
 		      at <- get bh
 		      return (UfFCall as at)
@@ -843,10 +836,6 @@ instance (Binary name) => Binary (UfConAlt name) where
     put_ bh (UfLitAlt ac) = do
 	    putByte bh 3
 	    put_ bh ac
-    put_ bh (UfLitLitAlt ad ae) = do
-	    putByte bh 4
-	    put_ bh ad
-	    put_ bh ae
     get bh = do
 	    h <- getByte bh
 	    case h of
@@ -855,11 +844,8 @@ instance (Binary name) => Binary (UfConAlt name) where
 		      return (UfDataAlt aa)
 	      2 -> do ab <- get bh
 		      return (UfTupleAlt ab)
-	      3 -> do ac <- get bh
+	      _ -> do ac <- get bh
 		      return (UfLitAlt ac)
-	      _ -> do ad <- get bh
-		      ae <- get bh
-		      return (UfLitLitAlt ad ae)
 
 instance (Binary name) => Binary (UfBinding name) where
     put_ bh (UfNonRec aa ab) = do
diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index 2d0718b3ee..6de5b11666 100644
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -75,7 +75,6 @@ module CmdLineOpts (
 	opt_DoSemiTagging,
 	opt_LiberateCaseThreshold,
 	opt_StgDoLetNoEscapes,
-	opt_UnfoldCasms,
 	opt_CprOff,
 	opt_RulesOff,
 	opt_UnboxStrictFields,
@@ -592,7 +591,6 @@ opt_RulesOff			= lookUp  FSLIT("-frules-off")
 	-- Switch off CPR analysis in the new demand analyser
 opt_LiberateCaseThreshold	= lookup_def_int "-fliberate-case-threshold" (10::Int)
 opt_StgDoLetNoEscapes		= lookUp  FSLIT("-flet-no-escape")
-opt_UnfoldCasms		        = lookUp  FSLIT("-funfold-casms-in-hi-file")
 opt_UnboxStrictFields		= lookUp  FSLIT("-funbox-strict-fields")
 opt_MaxWorkerArgs		= lookup_def_int "-fmax-worker-args" (10::Int)
 
@@ -666,7 +664,6 @@ isStaticHscFlag f =
 	"fflatten",
 	"fsemi-tagging",
 	"flet-no-escape",
-	"funfold-casms-in-hi-file",
 	"funbox-strict-fields",
 	"femit-extern-decls",
 	"fglobalise-toplev-names",
diff --git a/ghc/compiler/main/TidyPgm.lhs b/ghc/compiler/main/TidyPgm.lhs
index 5785fa5bb0..d5430807fe 100644
--- a/ghc/compiler/main/TidyPgm.lhs
+++ b/ghc/compiler/main/TidyPgm.lhs
@@ -10,7 +10,7 @@ module TidyPgm( tidyCorePgm, tidyCoreExpr ) where
 
 import CmdLineOpts	( DynFlags, DynFlag(..), opt_OmitInterfacePragmas )
 import CoreSyn
-import CoreUnfold	( noUnfolding, mkTopUnfolding, okToUnfoldInHiFile )
+import CoreUnfold	( noUnfolding, mkTopUnfolding )
 import CoreFVs		( ruleLhsFreeIds, ruleRhsFreeVars, exprSomeFreeVars )
 import CoreTidy		( tidyExpr, tidyVarOcc, tidyIdRules )
 import PprCore 		( pprIdRules )
@@ -374,8 +374,7 @@ addExternal (id,rhs) needed
     show_unfold = not bottoming_fn	 &&	-- Not necessary
 		  not dont_inline	 &&
 		  not loop_breaker	 &&
-		  rhs_is_small		 &&	-- Small enough
-		  okToUnfoldInHiFile rhs 	-- No casms etc
+		  rhs_is_small		 	-- Small enough
 
     unfold_ids | show_unfold = exprSomeFreeVars isLocalId rhs
 	       | otherwise   = emptyVarSet
diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index 1e9f0292b7..d1edcc022c 100644
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -50,14 +50,11 @@ foreignCallCode
 %*									*
 %************************************************************************
 
-First, the dreaded @ccall@.  We can't handle @casm@s.
+First, the dreaded @ccall@.
 
 Usually, this compiles to an assignment, but when the left-hand side
 is empty, we just perform the call and ignore the result.
 
-btw Why not let programmer use casm to provide assembly code instead
-of C code?  ADR
-
 ToDo: saving/restoring of volatile regs around ccalls.
 
 JRS, 001113: always do the call of suspendThread and resumeThread as a ccall
@@ -96,9 +93,6 @@ foreignCallCode lhs call@(CCall (CCallSpec ctarget cconv safety)) rhs
              StaticTarget nm -> (rhs, Left nm)
              DynamicTarget |  notNull rhs -- an assertion
                            -> (tail rhs, Right (amodeToStix (head rhs)))
-             CasmTarget _
-                -> ncgPrimopMoan "Native code generator can't handle foreign call" 
-                                 (ppr call)
 
     stix_args = map amodeToStix' cargs
 
@@ -187,7 +181,6 @@ amodeToStix (CLit core)
       MachNullAddr   -> StInt 0
       MachInt i      -> StInt i
       MachWord w     -> case word2IntLit core of MachInt iw -> StInt iw
-      MachLitLit s _ -> litLitErr
                                                        -- dreadful, but rare.
       MachLabel l (Just x) -> StCLbl (mkForeignLabel (mkFastString (unpackFS l ++ '@':show x)) False)
       MachLabel l _        -> StCLbl (mkForeignLabel l False{-ToDo: dynamic-})
@@ -221,9 +214,6 @@ amodeToStix (CMacroExpr _ macro [arg])
 
 amodeToStix other
    = pprPanic "StixPrim.amodeToStix" (pprAmode other)
-
-litLitErr 
-   = ncgPrimopMoan "native code generator can't handle lit-lits" empty
 \end{code}
 
 Sizes of the CharLike and IntLike closures that are arranged as arrays
diff --git a/ghc/compiler/parser/Lexer.x b/ghc/compiler/parser/Lexer.x
index aa5067f16e..264b7249bb 100644
--- a/ghc/compiler/parser/Lexer.x
+++ b/ghc/compiler/parser/Lexer.x
@@ -288,9 +288,6 @@ $white_no_nl+ 				;
   \" 				{ lex_string_tok }
 }
 
-<glaexts> "``" (([$graphic $whitechar] # \') | \' ([$graphic $whitechar] # \'))*
-		"''"		{ clitlit }
-
 {
 -- work around bug in Alex 2.0
 #if __GLASGOW_HASKELL__ < 503
@@ -341,7 +338,6 @@ data Token__
   | ITstdcallconv
   | ITccallconv
   | ITdotnet
-  | ITccall (Bool,Bool,Safety)	-- (is_dyn, is_casm, may_gc)
   | ITmdo
 
   | ITspecialise_prag		-- Pragmas
@@ -416,7 +412,6 @@ data Token__
   | ITprimint    Integer
   | ITprimfloat  Rational
   | ITprimdouble Rational
-  | ITlitlit     FastString
 
   -- MetaHaskell extension tokens
   | ITopenExpQuote  		-- [| or [e|
@@ -522,17 +517,7 @@ reservedWordsFM = listToUFM $
 	( "with",	ITwith,		 bit withBit),
 
 	( "rec",	ITrec,		 bit arrowsBit),
-	( "proc",	ITproc,		 bit arrowsBit),
-
-	-- On death row
-        ("_ccall_",	ITccall (False, False, PlayRisky),
-					 bit glaExtsBit),
-        ("_ccall_GC_",	ITccall (False, False, PlaySafe False),
-					 bit glaExtsBit),
-        ("_casm_",	ITccall (False, True,  PlayRisky),
-					 bit glaExtsBit),
-        ("_casm_GC_",	ITccall (False, True,  PlaySafe False),
-					 bit glaExtsBit)
+	( "proc",	ITproc,		 bit arrowsBit)
      ]
 
 reservedSymsFM = listToUFM $
@@ -749,10 +734,6 @@ parseInteger buf len radix to_int
   where go i x | i == len  = x
 	       | otherwise = go (i+1) (x * radix + toInteger (to_int (lookAhead buf i)))
 
-clitlit :: Action
-clitlit loc end buf len = 
-  return (T loc end (ITlitlit $! lexemeToFastString (stepOnBy 2 buf) (len-4)))
-
 -- -----------------------------------------------------------------------------
 -- Layout processing
 
diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index a4294e13dc..985e5016c5 100644
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-								-*-haskell-*-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.122 2003/09/08 11:52:25 simonmar Exp $
+$Id: Parser.y,v 1.123 2003/09/16 13:03:44 simonmar Exp $
 
 Haskell grammar.
 
@@ -134,10 +134,6 @@ Conflicts: 29 shift/reduce, [SDM 19/9/2002]
  'dotnet'       { T _ _ ITdotnet }
  'proc'		{ T _ _ ITproc }		-- for arrow notation extension
  'rec'		{ T _ _ ITrec }		-- for arrow notation extension
- '_ccall_'	{ T _ _ (ITccall (False, False, PlayRisky)) }
- '_ccall_GC_'	{ T _ _ (ITccall (False, False, PlaySafe False)) }
- '_casm_'	{ T _ _ (ITccall (False, True,  PlayRisky)) }
- '_casm_GC_'	{ T _ _ (ITccall (False, True,  PlaySafe False)) }
 
  '{-# SPECIALISE'  { T _ _ ITspecialise_prag }
  '{-# SOURCE'	   { T _ _ ITsource_prag }
@@ -211,7 +207,6 @@ Conflicts: 29 shift/reduce, [SDM 19/9/2002]
  PRIMINTEGER	{ T _ _ (ITprimint    $$) }
  PRIMFLOAT	{ T _ _ (ITprimfloat  $$) }
  PRIMDOUBLE	{ T _ _ (ITprimdouble $$) }
- CLITLIT	{ T _ _ (ITlitlit     $$) }
  
 -- Template Haskell
 '[|'            { T _ _ ITopenExpQuote  }       
@@ -937,11 +932,6 @@ exp10 :: { RdrNameHsExpr }
   	| srcloc 'mdo' stmtlist			{% checkMDo $3  >>= \ stmts ->
 						   return (mkHsDo MDoExpr stmts $1) }
 
-	| '_ccall_'    ccallid aexps0		{ HsCCall $2 $3 PlayRisky False placeHolderType }
-	| '_ccall_GC_' ccallid aexps0		{ HsCCall $2 $3 (PlaySafe False) False placeHolderType }
-	| '_casm_'     CLITLIT aexps0		{ HsCCall $2 $3 PlayRisky True  placeHolderType }
-	| '_casm_GC_'  CLITLIT aexps0		{ HsCCall $2 $3 (PlaySafe False) True  placeHolderType }
-
         | scc_annot exp		    		{ if opt_SccProfilingOn
 							then HsSCC $1 $2
 							else HsPar $2 }
@@ -1421,7 +1411,6 @@ literal :: { HsLit }
 	| PRIMSTRING		{ HsStringPrim $1 }
 	| PRIMFLOAT		{ HsFloatPrim  $1 }
 	| PRIMDOUBLE		{ HsDoublePrim $1 }
-	| CLITLIT		{ HsLitLit     $1 placeHolderType }
 
 srcloc :: { SrcLoc }	:	{% getSrcLoc }
 
diff --git a/ghc/compiler/prelude/ForeignCall.lhs b/ghc/compiler/prelude/ForeignCall.lhs
index 0197d64050..ab04abff25 100644
--- a/ghc/compiler/prelude/ForeignCall.lhs
+++ b/ghc/compiler/prelude/ForeignCall.lhs
@@ -12,13 +12,11 @@ module ForeignCall (
 
 	CExportSpec(..),
 	CCallSpec(..), 
-	CCallTarget(..), isDynamicTarget, isCasmTarget,
+	CCallTarget(..), isDynamicTarget,
 	CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute,
 
 	DNCallSpec(..), DNKind(..), DNType(..),
-	withDNTypes,
-
-	okToExposeFCall
+	withDNTypes
     ) where
 
 #include "HsVersions.h"
@@ -110,16 +108,12 @@ The call target:
 data CCallTarget
   = StaticTarget  CLabelString  -- An "unboxed" ccall# to `fn'.
   | DynamicTarget 		-- First argument (an Addr#) is the function pointer
-  | CasmTarget    CLabelString	-- Inline C code (now seriously deprecated)
   deriving( Eq )
   {-! derive: Binary !-}
 
-isDynamicTarget, isCasmTarget :: CCallTarget -> Bool
+isDynamicTarget :: CCallTarget -> Bool
 isDynamicTarget DynamicTarget = True
 isDynamicTarget other	      = False
-
-isCasmTarget (CasmTarget _) = True
-isCasmTarget other	    = False
 \end{code}
 
 
@@ -178,7 +172,6 @@ instance Outputable CCallSpec where
 
       ppr_fun DynamicTarget     = text "__dyn_ccall" <> gc_suf <+> text "\"\""
       ppr_fun (StaticTarget fn) = text "__ccall"     <> gc_suf <+> pprCLabelString fn
-      ppr_fun (CasmTarget   fn) = text "__casm"      <> gc_suf <+> text "``" <> pprCLabelString fn <> text "''"
 \end{code}
 
 
@@ -251,13 +244,6 @@ instance Outputable DNCallSpec where
 %************************************************************************
 
 \begin{code}
-okToExposeFCall :: ForeignCall -> Bool
--- OK to unfold a Foreign Call in an interface file
--- Yes, unless it's a _casm_
-okToExposeFCall (CCall (CCallSpec target _ _)) = not (isCasmTarget target)
-okToExposeFCall other  			       = True
-\end{code}
-\begin{code}
 {-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-}
 instance Binary ForeignCall where
     put_ bh (CCall aa) = do
@@ -313,17 +299,12 @@ instance Binary CCallTarget where
 	    put_ bh aa
     put_ bh DynamicTarget = do
 	    putByte bh 1
-    put_ bh (CasmTarget ab) = do
-	    putByte bh 2
-	    put_ bh ab
     get bh = do
 	    h <- getByte bh
 	    case h of
 	      0 -> do aa <- get bh
 		      return (StaticTarget aa)
-	      1 -> do return DynamicTarget
-	      _ -> do ab <- get bh
-		      return (CasmTarget ab)
+	      _ -> do return DynamicTarget
 
 instance Binary CCallConv where
     put_ bh CCallConv = do
diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs
index 256b03c769..c6afe14b79 100644
--- a/ghc/compiler/prelude/PrelInfo.lhs
+++ b/ghc/compiler/prelude/PrelInfo.lhs
@@ -10,24 +10,21 @@ module PrelInfo (
 
 	wiredInThingEnv,
 	ghcPrimExports,
-	cCallableClassDecl, cReturnableClassDecl,
 	knownKeyNames,
 	
 	-- Random other things
 	maybeCharLikeCon, maybeIntLikeCon,
 
 	-- Class categories
-	isCcallishClass, isCreturnableClass, isNoDictClass, 
-	isNumericClass, isStandardClass
+	isNoDictClass, isNumericClass, isStandardClass
 
     ) where
 
 #include "HsVersions.h"
 
 import PrelNames	( basicKnownKeyNames, 
-			  cCallableClassName, cReturnableClassName,
 			  hasKey, charDataConKey, intDataConKey,
-			  numericClassKeys, standardClassKeys, cCallishClassKeys,
+			  numericClassKeys, standardClassKeys,
 			  noDictClassKeys )
 #ifdef GHCI
 import DsMeta		( templateHaskellNames )
@@ -40,18 +37,16 @@ import Id		( idName )
 import MkId		( mkPrimOpId, wiredInIds )
 import MkId		-- All of it, for re-export
 import Name		( Name, nameOccName, NamedThing(..) )
-import RdrName		( mkRdrUnqual, getRdrName )
+import RdrName		( mkRdrUnqual )
 import HsSyn		( HsTyVarBndr(..) )
 import OccName		( mkVarOcc )
 import TysPrim		( primTyCons )
 import TysWiredIn	( wiredInTyCons )
-import RdrHsSyn		( mkClassDecl )
 import HscTypes 	( TyThing(..), implicitTyThings, TypeEnv, mkTypeEnv,
 			  GenAvailInfo(..), RdrAvailInfo )
 import Class	 	( Class, classKey, className )
 import Type		( funTyCon, openTypeKind, liftedTypeKind )
 import TyCon		( tyConName )
-import SrcLoc		( noSrcLoc )
 import Util		( isIn )
 \end{code}
 
@@ -104,36 +99,15 @@ sense of them in interface pragmas. It's cool, though they all have
 %************************************************************************
 
 GHC.Prim "exports" all the primops and primitive types, some 
-wired-in Ids, and the CCallable & CReturnable classes.
+wired-in Ids.
 
 \begin{code}
 ghcPrimExports :: [RdrAvailInfo]
- = AvailTC cCallableOcc [ cCallableOcc ] :
-   AvailTC cReturnableOcc [ cReturnableOcc ] :
-   map (Avail . nameOccName . idName) ghcPrimIds ++
+ = map (Avail . nameOccName . idName) ghcPrimIds ++
    map (Avail . primOpOcc) allThePrimOps ++
    [ AvailTC occ [occ] |
      n <- funTyCon : primTyCons, let occ = nameOccName (tyConName n) 
    ]
- where
-   cCallableOcc = nameOccName cCallableClassName
-   cReturnableOcc = nameOccName cReturnableClassName
-
-cCallableClassDecl
-  = mkClassDecl
-    ([], getRdrName cCallableClassName, [openAlpha])
-    [] -- no fds
-    [] -- no sigs
-    Nothing -- no mbinds
-    noSrcLoc
-
-cReturnableClassDecl
-  = mkClassDecl
-    ([], getRdrName cReturnableClassName, [openAlpha])
-    [] -- no fds
-    [] -- no sigs
-    Nothing -- no mbinds
-    noSrcLoc
 
 alpha = mkRdrUnqual (mkVarOcc FSLIT("a"))
 openAlpha = IfaceTyVar alpha openTypeKind
@@ -163,13 +137,10 @@ maybeIntLikeCon  con = con `hasKey` intDataConKey
 %************************************************************************
 
 \begin{code}
-isCcallishClass, isCreturnableClass, isNoDictClass, 
-  isNumericClass, isStandardClass :: Class -> Bool
+isNoDictClass, isNumericClass, isStandardClass :: Class -> Bool
 
 isNumericClass     clas = classKey clas `is_elem` numericClassKeys
 isStandardClass    clas = classKey clas `is_elem` standardClassKeys
-isCcallishClass	   clas = classKey clas `is_elem` cCallishClassKeys
-isCreturnableClass clas = className clas == cReturnableClassName
 isNoDictClass      clas = classKey clas `is_elem` noDictClassKeys
 is_elem = isIn "is_X_Class"
 \end{code}
diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs
index bacb0ec9ce..4c8f926f84 100644
--- a/ghc/compiler/prelude/PrelNames.lhs
+++ b/ghc/compiler/prelude/PrelNames.lhs
@@ -153,8 +153,6 @@ basicKnownKeyNames
 	floatingClassName,		-- numeric
 	realFracClassName,		-- numeric
 	realFloatClassName,		-- numeric
-	cCallableClassName,		-- mentioned, ccallish
-	cReturnableClassName,		-- mentioned, ccallish
 	dataClassName, 
 	typeableClassName,
 
@@ -356,8 +354,6 @@ numClass_RDR 		= nameRdrName numClassName
 ordClass_RDR 		= nameRdrName ordClassName
 enumClass_RDR		= nameRdrName enumClassName
 monadClass_RDR		= nameRdrName monadClassName
-cCallableClass_RDR	= nameRdrName cCallableClassName
-cReturnableClass_RDR	= nameRdrName cReturnableClassName
 
 map_RDR 		= varQual_RDR pREL_BASE_Name FSLIT("map")
 append_RDR 		= varQual_RDR pREL_BASE_Name FSLIT("++")
@@ -505,8 +501,6 @@ foreignObjPrimTyConName       = tcQual  gHC_PRIM_Name FSLIT("ForeignObj#") forei
 bcoPrimTyConName 	      = tcQual  gHC_PRIM_Name FSLIT("BCO#") bcoPrimTyConKey 
 weakPrimTyConName  	      = tcQual  gHC_PRIM_Name FSLIT("Weak#") weakPrimTyConKey 
 threadIdPrimTyConName  	      = tcQual  gHC_PRIM_Name FSLIT("ThreadId#") threadIdPrimTyConKey 
-cCallableClassName   	      = clsQual gHC_PRIM_Name FSLIT("CCallable") cCallableClassKey
-cReturnableClassName 	      = clsQual gHC_PRIM_Name FSLIT("CReturnable") cReturnableClassKey
 
 unsafeCoerceName = wVarQual gHC_PRIM_Name FSLIT("unsafeCoerce#") unsafeCoerceIdKey 
 nullAddrName     = wVarQual gHC_PRIM_Name FSLIT("nullAddr#")	nullAddrIdKey
@@ -788,8 +782,6 @@ realClassKey		= mkPreludeClassUnique 14
 realFloatClassKey	= mkPreludeClassUnique 15
 realFracClassKey	= mkPreludeClassUnique 16
 showClassKey		= mkPreludeClassUnique 17
-cCallableClassKey	= mkPreludeClassUnique 18
-cReturnableClassKey	= mkPreludeClassUnique 19
 ixClassKey		= mkPreludeClassUnique 20
 \end{code}
 
@@ -1114,24 +1106,9 @@ needsDataDeclCtxtClassKeys = -- see comments in TcDeriv
   	[ readClassKey
     	]
 
-cCallishClassKeys = 
-	[ cCallableClassKey
-	, cReturnableClassKey
-	]
+standardClassKeys = derivableClassKeys ++ numericClassKeys
 
-standardClassKeys
-  = derivableClassKeys ++ numericClassKeys ++ cCallishClassKeys
-    --
-    -- We have to have "CCallable" and "CReturnable" in the standard
-    -- classes, so that if you go...
-    --
-    --	    _ccall_ foo ... 93{-numeric literal-} ...
-    --
-    -- ... it can do The Right Thing on the 93.
-
-noDictClassKeys 	-- These classes are used only for type annotations;
-			-- they are not implemented by dictionaries, ever.
-  = cCallishClassKeys
+noDictClassKeys = [] -- ToDo: remove?
 \end{code}
 
 @derivableClassKeys@ is also used in checking \tr{deriving} constructs
diff --git a/ghc/compiler/prelude/PrelRules.lhs b/ghc/compiler/prelude/PrelRules.lhs
index c13d6ed75f..8f5df8c60e 100644
--- a/ghc/compiler/prelude/PrelRules.lhs
+++ b/ghc/compiler/prelude/PrelRules.lhs
@@ -21,7 +21,7 @@ module PrelRules ( primOpRules, builtinRules ) where
 
 import CoreSyn
 import Id		( mkWildId )
-import Literal		( Literal(..), isLitLitLit, mkMachInt, mkMachWord
+import Literal		( Literal(..), mkMachInt, mkMachWord
 			, literalType
 			, word2IntLit, int2WordLit
 			, narrow8IntLit, narrow16IntLit, narrow32IntLit
@@ -177,16 +177,14 @@ primOpRules op = primop_rule op
 %*									*
 %************************************************************************
 
-	IMPORTANT NOTE
-
-In all these operations we might find a LitLit as an operand; that's
-why we have the catch-all Nothing case.
+ToDo: the reason these all return Nothing is because there used to be
+the possibility of an argument being a litlit.  Litlits are now gone,
+so this could be cleaned up.
 
 \begin{code}
 --------------------------
 litCoerce :: (Literal -> Literal) -> Literal -> Maybe CoreExpr
-litCoerce fn lit | isLitLitLit lit = Nothing
-                 | otherwise       = Just (Lit (fn lit))
+litCoerce fn lit = Just (Lit (fn lit))
 
 --------------------------
 cmpOp :: (Ordering -> Bool) -> Literal -> Literal -> Maybe CoreExpr
diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index 23e41c0e9f..2b1f285ec4 100644
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -36,7 +36,6 @@ import BasicTypes	( Fixity(..), FixityDirection(..), IPName(..),
 			  defaultFixity, negateFixity, compareFixity )
 import PrelNames	( hasKey, assertIdKey, 
 			  foldrName, buildName, 
-			  cCallableClassName, cReturnableClassName, 
 			  enumClassName, 
 			  loopAName, choiceAName, appAName, arrAName, composeAName, firstAName,
 			  splitName, fstName, sndName, ioDataConName, 
@@ -261,14 +260,6 @@ rnExpr section@(SectionR op expr)
     checkSectionPrec InfixR section op' expr'	`thenM_`
     returnM (SectionR op' expr', fvs_op `plusFV` fvs_expr)
 
-rnExpr (HsCCall fun args may_gc is_casm _)
-	-- Check out the comment on RnIfaces.getNonWiredDataDecl about ccalls
-  = rnExprs args				`thenM` \ (args', fvs_args) ->
-    returnM (HsCCall fun args' may_gc is_casm placeHolderType, 
-	      fvs_args `plusFV` mkFVs [cCallableClassName, 
-				       cReturnableClassName, 
-				       ioDataConName])
-
 rnExpr (HsCoreAnn ann expr)
   = rnExpr expr `thenM` \ (expr', fvs_expr) ->
     returnM (HsCoreAnn ann expr', fvs_expr)
diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs
index 3ef8c26618..57b32e7326 100644
--- a/ghc/compiler/rename/RnHiFiles.lhs
+++ b/ghc/compiler/rename/RnHiFiles.lhs
@@ -39,7 +39,7 @@ import RnEnv
 import TcRnMonad
 
 import PrelNames	( gHC_PRIM_Name, gHC_PRIM )
-import PrelInfo		( ghcPrimExports, cCallableClassDecl, cReturnableClassDecl )
+import PrelInfo		( ghcPrimExports )
 import Name		( Name {-instance NamedThing-}, 
 			  nameModule, isInternalName )
 import NameEnv
@@ -685,8 +685,7 @@ ghcPrimIface = ParsedIface {
       pi_orphan  = False,
       pi_usages  = [],
       pi_exports = (1, [(gHC_PRIM_Name, ghcPrimExports)]),
-      pi_decls   = [(1,cCallableClassDecl), 
-		    (1,cReturnableClassDecl)],
+      pi_decls   = [],
       pi_fixity  = [FixitySig (nameRdrName (idName seqId)) 
 			      (Fixity 0 InfixR) noSrcLoc],
 		-- seq is infixr 0
diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 5c959d2e45..0d20ecf8a2 100644
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -209,7 +209,6 @@ hsIdInfoFVs other	     = emptyFVs
 ----------------
 ufExprFVs (UfVar n) 	  = unitFV n
 ufExprFVs (UfLit l) 	  = emptyFVs
-ufExprFVs (UfLitLit l ty) = extractHsTyNames ty
 ufExprFVs (UfFCall cc ty) = extractHsTyNames ty
 ufExprFVs (UfType ty)     = extractHsTyNames ty
 ufExprFVs (UfTuple tc es) = hsTupConFVs tc `plusFV` plusFVs (map ufExprFVs es)
@@ -229,7 +228,6 @@ ufAltFVs (con, vs, e) = ufConFVs con `plusFV` delFVs vs (ufExprFVs e)
 
 ufConFVs (UfDataAlt n)      = unitFV n
 ufConFVs (UfTupleAlt t)     = hsTupConFVs t
-ufConFVs (UfLitLitAlt _ ty) = extractHsTyNames ty
 ufConFVs other		    = emptyFVs
 
 ufNoteFVs (UfCoerce ty) = extractHsTyNames ty
diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index f74c71244e..35ebab2d41 100644
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -809,10 +809,6 @@ rnCoreExpr (UfVar v)
 rnCoreExpr (UfLit l)
   = returnM (UfLit l)
 
-rnCoreExpr (UfLitLit l ty)
-  = rnHsType (text "litlit") ty	`thenM` \ ty' ->
-    returnM (UfLitLit l ty')
-
 rnCoreExpr (UfFCall cc ty)
   = rnHsType (text "ccall") ty	`thenM` \ ty' ->
     returnM (UfFCall cc ty')
@@ -903,10 +899,6 @@ rnUfCon (UfDataAlt con)
 
 rnUfCon (UfLitAlt lit)
   = returnM (UfLitAlt lit)
-
-rnUfCon (UfLitLitAlt lit ty)
-  = rnHsType (text "litlit") ty		`thenM` \ ty' ->
-    returnM (UfLitLitAlt lit ty')
 \end{code}
 
 %*********************************************************
diff --git a/ghc/compiler/rename/RnTypes.lhs b/ghc/compiler/rename/RnTypes.lhs
index fed9f0de9c..86445877f6 100644
--- a/ghc/compiler/rename/RnTypes.lhs
+++ b/ghc/compiler/rename/RnTypes.lhs
@@ -24,9 +24,9 @@ import RnEnv	( lookupOccRn, lookupBndrRn, lookupSyntaxName, lookupGlobalOccRn,
 		  bindPatSigTyVarsFV, bindLocalsFV, warnUnusedMatches )
 import TcRnMonad
 
-import PrelNames( cCallishClassKeys, eqStringName, eqClassName, integralClassName, 
+import PrelNames( eqStringName, eqClassName, integralClassName, 
 		  negateName, minusName, lengthPName, indexPName, plusIntegerName, fromIntegerName,
-		  timesIntegerName, ratioDataConName, fromRationalName, cCallableClassName )
+		  timesIntegerName, ratioDataConName, fromRationalName )
 import Constants	( mAX_TUPLE_SIZE )
 import TysWiredIn	( intTyCon )
 import TysPrim		( charPrimTyCon, addrPrimTyCon, intPrimTyCon, 
@@ -264,19 +264,9 @@ rnContext doc ctxt
 
     returnM theta
   where
-   	--Someone discovered that @CCallable@ and @CReturnable@
-	-- could be used in contexts such as:
-	--	foo :: CCallable a => a -> PrimIO Int
-	-- Doing this utterly wrecks the whole point of introducing these
-	-- classes so we specifically check that this isn't being done.
     rn_pred pred = rnPred doc pred				`thenM` \ pred'->
-		   checkErr (not (bad_pred pred'))
-			    (naughtyCCallContextErr pred')	`thenM_`
 		   returnM pred'
 
-    bad_pred (HsClassP clas _) = getUnique clas `elem` cCallishClassKeys
-    bad_pred other	       = False
-
 
 rnPred doc (HsClassP clas tys)
   = lookupOccRn clas		`thenM` \ clas_name ->
@@ -506,7 +496,6 @@ litFVs (HsInt i)	      = returnM (unitFV (getName intTyCon))
 litFVs (HsIntPrim i)          = returnM (unitFV (getName intPrimTyCon))
 litFVs (HsFloatPrim f)        = returnM (unitFV (getName floatPrimTyCon))
 litFVs (HsDoublePrim d)       = returnM (unitFV (getName doublePrimTyCon))
-litFVs (HsLitLit l bogus_ty)  = returnM (unitFV cCallableClassName)
 litFVs lit		      = pprPanic "RnExpr.litFVs" (ppr lit)	-- HsInteger and HsRat only appear 
 									-- in post-typechecker translations
 bogusCharError c
diff --git a/ghc/compiler/stgSyn/StgSyn.lhs b/ghc/compiler/stgSyn/StgSyn.lhs
index b9f36716e9..ed1dacfb24 100644
--- a/ghc/compiler/stgSyn/StgSyn.lhs
+++ b/ghc/compiler/stgSyn/StgSyn.lhs
@@ -34,7 +34,7 @@ module StgSyn (
 
 	-- utils
 	stgBindHasCafRefs,  stgArgHasCafRefs, stgRhsArity, getArgPrimRep, 
-	isLitLitArg, isDllConApp, isStgTypeArg,
+	isDllConApp, isStgTypeArg,
 	stgArgType, stgBinders,
 
 	pprStgBinding, pprStgBindings, pprStgBindingsWithSRTs
@@ -52,7 +52,7 @@ import Var		( isId )
 import Id		( Id, idName, idPrimRep, idType, idCafInfo )
 import IdInfo		( mayHaveCafRefs )
 import Name		( isDllName )
-import Literal		( Literal, literalType, isLitLitLit, literalPrimRep )
+import Literal		( Literal, literalType, literalPrimRep )
 import ForeignCall	( ForeignCall )
 import DataCon		( DataCon, dataConName )
 import CoreSyn		( AltCon )
@@ -107,17 +107,14 @@ data GenStgArg occ
 getArgPrimRep (StgVarArg local) = idPrimRep local
 getArgPrimRep (StgLitArg lit)	= literalPrimRep lit
 
-isLitLitArg (StgLitArg lit) = isLitLitLit lit
-isLitLitArg _		    = False
-
 isStgTypeArg (StgTypeArg _) = True
 isStgTypeArg other	    = False
 
 isDllArg :: StgArg -> Bool
 	-- Does this argument refer to something in a different DLL?
-isDllArg (StgTypeArg v)   = False
+isDllArg (StgTypeArg v)  = False
 isDllArg (StgVarArg v)   = isDllName (idName v)
-isDllArg (StgLitArg lit) = isLitLitLit lit
+isDllArg (StgLitArg lit) = False
 
 isDllConApp :: DataCon -> [StgArg] -> Bool
 	-- Does this constructor application refer to 
diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
index 9f3c6842c5..61bfd6018a 100644
--- a/ghc/compiler/typecheck/Inst.lhs
+++ b/ghc/compiler/typecheck/Inst.lhs
@@ -27,7 +27,7 @@ module Inst (
 	isDict, isClassDict, isMethod, 
 	isLinearInst, linearInstType, isIPDict, isInheritableInst,
 	isTyVarDict, isStdClassTyVarDict, isMethodFor, 
-	instBindingRequired, instCanBeGeneralised,
+	instBindingRequired,
 
 	zonkInst, zonkInsts,
 	instToId, instName,
@@ -65,7 +65,7 @@ import TcType	( Type, TcType, TcThetaType, TcTyVarSet,
 import CoreFVs	( idFreeTyVars )
 import DataCon	( DataCon,dataConSig )
 import Id	( Id, idName, idType, mkUserLocal, mkSysLocal, mkLocalId, setIdUnique )
-import PrelInfo	( isStandardClass, isCcallishClass, isNoDictClass )
+import PrelInfo	( isStandardClass, isNoDictClass )
 import Name	( Name, mkMethodOcc, getOccName )
 import PprType	( pprPred, pprParendType )	
 import Subst	( substTy, substTyWith, substTheta, mkTyVarSubst )
@@ -194,10 +194,6 @@ must be witnessed by an actual binding; the second tells whether an
 instBindingRequired :: Inst -> Bool
 instBindingRequired (Dict _ (ClassP clas _) _) = not (isNoDictClass clas)
 instBindingRequired other		       = True
-
-instCanBeGeneralised :: Inst -> Bool
-instCanBeGeneralised (Dict _ (ClassP clas _) _) = not (isCcallishClass clas)
-instCanBeGeneralised other		        = True
 \end{code}
 
 
diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
index f88969753d..7b55afd6a2 100644
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ b/ghc/compiler/typecheck/TcExpr.lhs
@@ -54,8 +54,7 @@ import TyCon		( TyCon, tyConTyVars, tyConTheta, isAlgTyCon, tyConDataCons )
 import Subst		( mkTopTyVarSubst, substTheta, substTy )
 import VarSet		( emptyVarSet, elemVarSet )
 import TysWiredIn	( boolTy )
-import PrelNames	( cCallableClassName, cReturnableClassName, 
-			  enumFromName, enumFromThenName, 
+import PrelNames	( enumFromName, enumFromThenName, 
 			  enumFromToName, enumFromThenToName,
 			  enumFromToPName, enumFromThenToPName,
 			  ioTyConName
@@ -314,70 +313,6 @@ tcMonoExpr (HsProc pat cmd loc) res_ty
     returnM (HsProc pat' cmd' loc)
 \end{code}
 
-
-%************************************************************************
-%*									*
-		Foreign calls
-%*									*
-%************************************************************************
-
-The interesting thing about @ccall@ is that it is just a template
-which we instantiate by filling in details about the types of its
-argument and result (ie minimal typechecking is performed).  So, the
-basic story is that we allocate a load of type variables (to hold the
-arg/result types); unify them with the args/result; and store them for
-later use.
-
-\begin{code}
-tcMonoExpr e0@(HsCCall lbl args may_gc is_casm ignored_fake_result_ty) res_ty
-
-  = getDOpts				`thenM` \ dflags ->
-
-    checkTc (not (is_casm && dopt_HscLang dflags /= HscC)) 
-        (vcat [text "_casm_ is only supported when compiling via C (-fvia-C).",
-               text "Either compile with -fvia-C, or, better, rewrite your code",
-               text "to use the foreign function interface.  _casm_s are deprecated",
-               text "and support for them may one day disappear."])
-					`thenM_`
-
-    -- Get the callable and returnable classes.
-    tcLookupClass cCallableClassName	`thenM` \ cCallableClass ->
-    tcLookupClass cReturnableClassName	`thenM` \ cReturnableClass ->
-    tcLookupTyCon ioTyConName		`thenM` \ ioTyCon ->
-    let
-	new_arg_dict (arg, arg_ty)
-	  = newDicts (CCallOrigin (unpackFS lbl) (Just arg))
-		     [mkClassPred cCallableClass [arg_ty]]	`thenM` \ arg_dicts ->
-	    returnM arg_dicts	-- Actually a singleton bag
-
-	result_origin = CCallOrigin (unpackFS lbl) Nothing {- Not an arg -}
-    in
-
-	-- Arguments
-    let tv_idxs | null args  = []
-		| otherwise  = [1..length args]
-    in
-    newTyVarTys (length tv_idxs) openTypeKind		`thenM` \ arg_tys ->
-    tcCheckRhos args arg_tys		   		`thenM` \ args' ->
-
-	-- The argument types can be unlifted or lifted; the result
-	-- type must, however, be lifted since it's an argument to the IO
-	-- type constructor.
-    newTyVarTy liftedTypeKind  		`thenM` \ result_ty ->
-    let
-	io_result_ty = mkTyConApp ioTyCon [result_ty]
-    in
-    zapExpectedTo res_ty io_result_ty	`thenM_`
-
-	-- Construct the extra insts, which encode the
-	-- constraints on the argument and result types.
-    mappM new_arg_dict (zipEqual "tcMonoExpr:CCall" args arg_tys)	`thenM` \ ccarg_dicts_s ->
-    newDicts result_origin [mkClassPred cReturnableClass [result_ty]]	`thenM` \ ccres_dict ->
-    extendLIEs (ccres_dict ++ concat ccarg_dicts_s)			`thenM_`
-    returnM (HsCCall lbl args' may_gc is_casm io_result_ty)
-\end{code}
-
-
 %************************************************************************
 %*									*
 		Record construction and update
@@ -1025,14 +960,6 @@ Overloaded literals.
 
 \begin{code}
 tcLit :: HsLit -> Expected TcRhoType -> TcM TcExpr
-tcLit (HsLitLit s _) res_ty
-  = zapExpectedType res_ty				`thenM` \ res_ty' ->
-    tcLookupClass cCallableClassName			`thenM` \ cCallableClass ->
-    newDicts (LitLitOrigin (unpackFS s))
-	     [mkClassPred cCallableClass [res_ty']]	`thenM` \ dicts ->
-    extendLIEs dicts					`thenM_`
-    returnM (HsLit (HsLitLit s res_ty'))
-
 tcLit lit res_ty 
   = zapExpectedTo res_ty (hsLitType lit)		`thenM_`
     returnM (HsLit lit)
diff --git a/ghc/compiler/typecheck/TcForeign.lhs b/ghc/compiler/typecheck/TcForeign.lhs
index accb750f2a..04e6ce4709 100644
--- a/ghc/compiler/typecheck/TcForeign.lhs
+++ b/ghc/compiler/typecheck/TcForeign.lhs
@@ -46,7 +46,7 @@ import TcType		( Type, tcSplitFunTys, tcSplitTyConApp_maybe,
 			  toDNType
 			)
 import ForeignCall	( CExportSpec(..), CCallTarget(..), 
-			  isDynamicTarget, isCasmTarget, withDNTypes, DNKind(..), DNCallSpec(..) ) 
+			  isDynamicTarget, withDNTypes, DNKind(..), DNCallSpec(..) ) 
 import CStrings		( CLabelString, isCLabelString )
 import PrelNames	( hasKey, ioTyConKey )
 import CmdLineOpts	( dopt_HscLang, HscLang(..) )
@@ -154,8 +154,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ safety _ _ (CFunction targe
 	checkForeignRes nonIOok (isFFIImportResultTy dflags) res_ty  `thenM_`
 	return idecl
   | otherwise 		-- Normal foreign import
-  = checkCg (if isCasmTarget target
-	     then checkC else checkCOrAsmOrDotNetOrInterp)	`thenM_`
+  = checkCg (checkCOrAsmOrDotNetOrInterp)			`thenM_`
     checkCTarget target						`thenM_`
     getDOpts							`thenM` \ dflags ->
     checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys	`thenM_`
@@ -167,9 +166,6 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ safety _ _ (CFunction targe
 checkCTarget (StaticTarget str) 
   = checkCg checkCOrAsmOrDotNetOrInterp	 	`thenM_`
     check (isCLabelString str) (badCName str)
-
-checkCTarget (CasmTarget _)
-  = checkCg checkC
 \end{code}
 
 On an Alpha, with foreign export dynamic, due to a giant hack when
diff --git a/ghc/compiler/typecheck/TcHsSyn.lhs b/ghc/compiler/typecheck/TcHsSyn.lhs
index 2b30c3c27d..dd27a91f08 100644
--- a/ghc/compiler/typecheck/TcHsSyn.lhs
+++ b/ghc/compiler/typecheck/TcHsSyn.lhs
@@ -191,7 +191,6 @@ hsLitType (HsInteger i)    = integerTy
 hsLitType (HsRat _ ty)	   = ty
 hsLitType (HsFloatPrim f)  = floatPrimTy
 hsLitType (HsDoublePrim d) = doublePrimTy
-hsLitType (HsLitLit _ ty)  = ty
 \end{code}
 
 %************************************************************************
@@ -488,10 +487,6 @@ zonkExpr env (HsLit (HsRat f ty))
   = zonkTcTypeToType env ty	   `thenM` \ new_ty  ->
     returnM (HsLit (HsRat f new_ty))
 
-zonkExpr env (HsLit (HsLitLit lit ty))
-  = zonkTcTypeToType env ty	    `thenM` \ new_ty  ->
-    returnM (HsLit (HsLitLit lit new_ty))
-
 zonkExpr env (HsLit lit)
   = returnM (HsLit lit)
 
@@ -605,11 +600,6 @@ zonkExpr env (PArrSeqOut expr info)
     zonkArithSeq env info	`thenM` \ new_info ->
     returnM (PArrSeqOut new_expr new_info)
 
-zonkExpr env (HsCCall fun args may_gc is_casm result_ty)
-  = zonkExprs env args			`thenM` \ new_args ->
-    zonkTcTypeToType env result_ty	`thenM` \ new_result_ty ->
-    returnM (HsCCall fun new_args may_gc is_casm new_result_ty)
-
 zonkExpr env (HsSCC lbl expr)
   = zonkExpr env expr	`thenM` \ new_expr ->
     returnM (HsSCC lbl new_expr)
diff --git a/ghc/compiler/typecheck/TcIfaceSig.lhs b/ghc/compiler/typecheck/TcIfaceSig.lhs
index 5295fec764..ebfdb499be 100644
--- a/ghc/compiler/typecheck/TcIfaceSig.lhs
+++ b/ghc/compiler/typecheck/TcIfaceSig.lhs
@@ -230,12 +230,6 @@ tcCoreExpr (UfVar name)
 tcCoreExpr (UfLit lit)
   = returnM (Lit lit)
 
--- The dreaded lit-lits are also similar, except here the type
--- is read in explicitly rather than being implicit
-tcCoreExpr (UfLitLit lit ty)
-  = tcIfaceType ty		`thenM` \ ty' ->
-    returnM (Lit (MachLitLit lit ty'))
-
 tcCoreExpr (UfFCall cc ty)
   = tcIfaceType ty 	`thenM` \ ty' ->
     newUnique		`thenM` \ u ->
@@ -349,12 +343,6 @@ tcCoreAlt scrut_ty (UfLitAlt lit, names, rhs)
     tcCoreExpr rhs		`thenM` \ rhs' ->
     returnM (LitAlt lit, [], rhs')
 
-tcCoreAlt scrut_ty (UfLitLitAlt str ty, names, rhs)
-  = ASSERT( null names )
-    tcCoreExpr rhs		`thenM` \ rhs' ->
-    tcIfaceType ty		`thenM` \ ty' ->
-    returnM (LitAlt (MachLitLit str ty'), [], rhs')
-
 -- A case alternative is made quite a bit more complicated
 -- by the fact that we omit type annotations because we can
 -- work them out.  True enough, but its not that easy!
diff --git a/ghc/compiler/typecheck/TcMType.lhs b/ghc/compiler/typecheck/TcMType.lhs
index 207411cda5..cc45bf4a16 100644
--- a/ghc/compiler/typecheck/TcMType.lhs
+++ b/ghc/compiler/typecheck/TcMType.lhs
@@ -76,7 +76,7 @@ import Var		( TyVar, idType, idName, tyVarKind, tyVarName, isTyVar,
 -- others:
 import Generics		( validGenericMethodType )
 import TcRnMonad          -- TcType, amongst others
-import PrelNames	( cCallableClassKey, cReturnableClassKey, hasKey )
+import PrelNames	( hasKey )
 import ForeignCall	( Safety(..) )
 import FunDeps		( grow )
 import PprType		( pprPred, pprSourceType, pprTheta, pprClassPred )
@@ -1106,15 +1106,6 @@ checkValidInstHead ty	-- Should be a source type
     }}
 
 check_inst_head dflags clas tys
-  |	-- CCALL CHECK
-	-- A user declaration of a CCallable/CReturnable instance
-	-- must be for a "boxed primitive" type.
-        (clas `hasKey` cCallableClassKey   
-            && not (ccallable_type first_ty)) 
-  ||    (clas `hasKey` cReturnableClassKey 
-            && not (creturnable_type first_ty))
-  = failWithTc (nonBoxedPrimCCallErr clas first_ty)
-
 	-- If GlasgowExts then check at least one isn't a type variable
   | dopt Opt_GlasgowExts dflags
   = check_tyvars dflags clas tys
@@ -1134,9 +1125,6 @@ check_inst_head dflags clas tys
   where
     (first_ty : _)       = tys
 
-    ccallable_type   ty = isFFIArgumentTy dflags PlayRisky ty
-    creturnable_type ty = isFFIImportResultTy dflags ty
-	
     head_shape_msg = parens (text "The instance type must be of form (T a b c)" $$
 			     text "where T is not a synonym, and a,b,c are distinct type variables")
 
@@ -1157,8 +1145,4 @@ undecidableMsg = ptext SLIT("Use -fallow-undecidable-instances to permit this")
 instTypeErr pp_ty msg
   = sep [ptext SLIT("Illegal instance declaration for") <+> quotes pp_ty, 
 	 nest 4 msg]
-
-nonBoxedPrimCCallErr clas inst_ty
-  = hang (ptext SLIT("Unacceptable instance type for ccall-ish class"))
-	 4 (pprClassPred clas [inst_ty])
 \end{code}
diff --git a/ghc/compiler/typecheck/TcPat.lhs b/ghc/compiler/typecheck/TcPat.lhs
index 133db82eb7..b0bb16bf9c 100644
--- a/ghc/compiler/typecheck/TcPat.lhs
+++ b/ghc/compiler/typecheck/TcPat.lhs
@@ -36,7 +36,7 @@ import TysWiredIn	( stringTy )
 import CmdLineOpts	( opt_IrrefutableTuples )
 import DataCon		( DataCon, dataConFieldLabels, dataConSourceArity )
 import PrelNames	( eqStringName, eqName, geName, negateName, minusName, 
-			  integralClassName, cCallableClassName )
+			  integralClassName )
 import BasicTypes	( isBoxed )
 import Bag
 import Outputable
@@ -242,15 +242,6 @@ tcPat tc_bndr pat_in@(ConPatIn con_name arg_pats) pat_ty
 %************************************************************************
 
 \begin{code}
-tcPat tc_bndr (LitPat lit@(HsLitLit s _)) pat_ty 
-	-- cf tcExpr on LitLits
-  = zapExpectedType pat_ty				`thenM` \ pat_ty' ->
-    tcLookupClass cCallableClassName			`thenM` \ cCallableClass ->
-    newDicts (LitLitOrigin (unpackFS s))
-	     [mkClassPred cCallableClass [pat_ty']]	`thenM` \ dicts ->
-    extendLIEs dicts					`thenM_`
-    returnM (LitPat (HsLitLit s pat_ty'), emptyBag, emptyBag, [])
-
 tcPat tc_bndr pat@(LitPat lit@(HsString _)) pat_ty
   = zapExpectedType pat_ty		`thenM` \ pat_ty' ->
     unifyTauTy pat_ty' stringTy		`thenM_` 
diff --git a/ghc/compiler/typecheck/TcRnTypes.lhs b/ghc/compiler/typecheck/TcRnTypes.lhs
index c5620e7360..1408eda7e6 100644
--- a/ghc/compiler/typecheck/TcRnTypes.lhs
+++ b/ghc/compiler/typecheck/TcRnTypes.lhs
@@ -919,8 +919,6 @@ data InstOrigin
 			(Maybe RenamedHsExpr)	-- Nothing if it's the result
 						-- Just arg, for an argument
 
-  | LitLitOrigin	String	-- the litlit
-
   | UnknownOrigin	-- Help! I give up...
 \end{code}
 
@@ -969,8 +967,6 @@ pprInstLoc (InstLoc orig locn ctxt)
     pp_orig (CCallOrigin clabel (Just arg_expr))
 	= hsep [ptext SLIT("an argument in the _ccall_ to"), quotes (text clabel) <> comma, 
 		text "namely", quotes (ppr arg_expr)]
-    pp_orig (LitLitOrigin s)
-	= hsep [ptext SLIT("the ``literal-literal''"), quotes (text s)]
     pp_orig (UnknownOrigin)
 	= ptext SLIT("...oops -- I don't know where the overloading came from!")
 \end{code}
diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index 1eadf03858..1970ab387f 100644
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -33,7 +33,7 @@ import Inst		( lookupInst, LookupInstResult(..),
 			  isStdClassTyVarDict, isMethodFor, isMethod,
 			  instToId, tyVarsOfInsts,  cloneDict,
 			  ipNamesOfInsts, ipNamesOfInst, dictPred,
-			  instBindingRequired, instCanBeGeneralised,
+			  instBindingRequired,
 			  newDictsFromOld, tcInstClassOp,
 			  getDictClassTys, isTyVarDict,
 			  instLoc, zonkInst, tidyInsts, tidyMoreInsts,
@@ -53,7 +53,7 @@ import Name		( getOccName, getSrcLoc )
 import NameSet		( NameSet, mkNameSet, elemNameSet )
 import Class		( classBigSig, classKey )
 import FunDeps		( oclose, grow, improve, pprEquationDoc )
-import PrelInfo		( isNumericClass, isCreturnableClass, isCcallishClass ) 
+import PrelInfo		( isNumericClass ) 
 import PrelNames	( splitName, fstName, sndName, showClassKey, eqClassKey, ordClassKey)
 import HscTypes		( GhciMode(Interactive) )
 
@@ -552,9 +552,6 @@ tcSimplifyInfer doc tau_tvs wanted_lie
   = inferLoop doc (varSetElems tau_tvs)
 	      wanted_lie		`thenM` \ (qtvs, frees, binds, irreds) ->
 
-	-- Check for non-generalisable insts
-    mappM_ addCantGenErr (filter (not . instCanBeGeneralised) irreds)	`thenM_`
-
     extendLIEs frees							`thenM_`
     returnM (qtvs, binds, map instToId irreds)
 
@@ -1081,6 +1078,7 @@ data Avail
 
   | NoRhs 		-- Used for Insts like (CCallable f)
 			-- where no witness is required.
+			-- ToDo: remove?
 
   | Rhs 		-- Used when there is a RHS
 	TcExpr	 	-- The RHS
@@ -1773,10 +1771,6 @@ disambigGroup :: Bool	-- True <=> simplifying at top-level interactive loop
 
 disambigGroup is_interactive dicts
   |   any std_default_class classes 	-- Guaranteed all standard classes
-	  -- See comment at the end of function for reasons as to
-	  -- why the defaulting mechanism doesn't apply to groups that
-	  -- include CCallable or CReturnable dicts.
-   && not (any isCcallishClass classes)
   = 	-- THE DICTS OBEY THE DEFAULTABLE CONSTRAINT
 	-- SO, TRY DEFAULT TYPES IN ORDER
 
@@ -1803,9 +1797,6 @@ disambigGroup is_interactive dicts
 	Left  _ 		-> bomb_out
 	Right chosen_default_ty -> choose_default chosen_default_ty
 
-  | all isCreturnableClass classes	-- Default CCall stuff to ()
-  = choose_default unitTy
-
   | otherwise 				-- No defaults
   = bomb_out
 
@@ -2155,9 +2146,4 @@ reduceDepthErr n stack
 	  nest 4 (pprInstsInFull stack)]
 
 reduceDepthMsg n stack = nest 4 (pprInstsInFull stack)
-
------------------------------------------------
-addCantGenErr inst
-  = addErrTc (sep [ptext SLIT("Cannot generalise these overloadings (in a _ccall_):"),
-		   nest 4 (ppr inst <+> pprInstLoc (instLoc inst))])
 \end{code}
author	simonmar <unknown>	2003-09-16 13:03:49 +0000
committer	simonmar <unknown>	2003-09-16 13:03:49 +0000
commit	2129fa6fc4afd7f7b0c767f8c0c14b9ab5508ec2 (patch)
tree	c4d6d2888c582f17f46dedc88678bb7ec0f1e364
parent	ce42f19f8c840fbe89844471a0d850d310a94556 (diff)
download	haskell-2129fa6fc4afd7f7b0c767f8c0c14b9ab5508ec2.tar.gz