X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeGen.lhs;h=8e90d7d5786283b1160ee71fa8ce7ad8499ddc3a;hb=db4f42a8e38bfead11f5af78557e18b9f42b10b3;hp=d6545868fb99e9a8bf4302046ba8f1cc967cbb0f;hpb=83d563cb9ede0ba792836e529b1e2929db926355;p=ghc-hetmet.git diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs index d654586..8e90d7d 100644 --- a/compiler/ghci/ByteCodeGen.lhs +++ b/compiler/ghci/ByteCodeGen.lhs @@ -30,10 +30,7 @@ import CoreFVs import Type import DataCon import TyCon --- import Type import Util --- import DataCon -import Var import VarSet import TysPrim import DynFlags @@ -253,7 +250,7 @@ schemeR fvs (nm, rhs) {- | trace (showSDoc ( (char ' ' - $$ (ppr.filter (not.isTyCoVar).varSetElems.fst) rhs + $$ (ppr.filter (not.isTyVar).varSetElems.fst) rhs $$ pprCoreExpr (deAnnotate rhs) $$ char ' ' ))) False @@ -298,7 +295,7 @@ schemeER_wrk d p rhs | Just (tickInfo, (_annot, newRhs)) <- isTickedExp' rhs = do code <- schemeE d 0 p newRhs arr <- getBreakArray - let idOffSets = getVarOffSets (fromIntegral d) p tickInfo + let idOffSets = getVarOffSets d p tickInfo let tickNumber = tickInfo_number tickInfo let breakInfo = BreakInfo { breakInfo_module = tickInfo_module tickInfo @@ -640,13 +637,13 @@ schemeT d s p app -- Detect and extract relevant info for the tagToEnum kludge. maybe_is_tagToEnum_call = let extract_constr_Names ty - | Just (tyc, []) <- splitTyConApp_maybe (repType ty), + | Just (tyc, _) <- splitTyConApp_maybe (repType ty), isDataTyCon tyc = map (getName . dataConWorkId) (tyConDataCons tyc) -- NOTE: use the worker name, not the source name of -- the DataCon. See DataCon.lhs for details. | otherwise - = panic "maybe_is_tagToEnum_call.extract_constr_Ids" + = pprPanic "maybe_is_tagToEnum_call.extract_constr_Ids" (ppr ty) in case app of (AnnApp (_, AnnApp (_, AnnVar v) (_, AnnType t)) arg) @@ -838,7 +835,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple rhs_code <- schemeE (d_alts+size) s p' rhs return (my_discr alt, unitOL (UNPACK size) `appOL` rhs_code) where - real_bndrs = filter (not.isTyCoVar) bndrs + real_bndrs = filterOut isTyVar bndrs my_discr (DEFAULT, _, _) = NoDiscr {-shouldn't really happen-} my_discr (DataAlt dc, _, _) @@ -1460,7 +1457,7 @@ bcView :: AnnExpr' Var ann -> Maybe (AnnExpr' Var ann) -- whereas value lambdas cannot; that is why they are nuked here bcView (AnnNote _ (_,e)) = Just e bcView (AnnCast (_,e) _) = Just e -bcView (AnnLam v (_,e)) | isTyCoVar v = Just e +bcView (AnnLam v (_,e)) | isTyVar v = Just e bcView (AnnApp (_,e) (_, AnnType _)) = Just e bcView _ = Nothing @@ -1565,9 +1562,9 @@ getBreakArray = BcM $ \st -> return (st, breakArray st) newUnique :: BcM Unique newUnique = BcM $ - \st -> case splitUniqSupply (uniqSupply st) of - (us1, us2) -> let newState = st { uniqSupply = us2 } - in return (newState, uniqFromSupply us1) + \st -> case takeUniqFromSupply (uniqSupply st) of + (uniq, us) -> let newState = st { uniqSupply = us } + in return (newState, uniq) newId :: Type -> BcM Id newId ty = do