[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

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

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)
 

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)

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

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}

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

ghc/compiler/deSugar/DsCCall.lhs

 %
 % (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

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 ->

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]		     $

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"

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}
 

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}
 

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

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 ]
 

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}
-
-

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

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",

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

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

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