Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : type-holes-branch
http://hackage.haskell.org/trac/ghc/changeset/35fb703d71641df666ccc307d8014e9b9a91b1eb >--------------------------------------------------------------- commit 35fb703d71641df666ccc307d8014e9b9a91b1eb Author: Thijs Alkemade <[email protected]> Date: Wed Jul 18 13:50:19 2012 +0200 Removed Holes completely from Core. >--------------------------------------------------------------- compiler/coreSyn/CoreFVs.lhs | 2 -- compiler/coreSyn/CorePrep.lhs | 1 - compiler/coreSyn/CoreSubst.lhs | 2 -- compiler/coreSyn/CoreSyn.lhs | 3 --- compiler/coreSyn/CoreTidy.lhs | 1 - compiler/coreSyn/CoreUnfold.lhs | 1 - compiler/coreSyn/PprCore.lhs | 2 -- compiler/ghci/ByteCodeGen.lhs | 4 ---- compiler/simplCore/OccurAnal.lhs | 2 -- compiler/simplCore/Simplify.lhs | 1 - 10 files changed, 0 insertions(+), 19 deletions(-) diff --git a/compiler/coreSyn/CoreFVs.lhs b/compiler/coreSyn/CoreFVs.lhs index 8d1f239..d2bb6ed 100644 --- a/compiler/coreSyn/CoreFVs.lhs +++ b/compiler/coreSyn/CoreFVs.lhs @@ -195,7 +195,6 @@ expr_fvs (Let (NonRec bndr rhs) body) expr_fvs (Let (Rec pairs) body) = addBndrs (map fst pairs) (foldr (union . rhs_fvs) (expr_fvs body) pairs) -expr_fvs (Hole src) = noVars --------- rhs_fvs :: (Id,CoreExpr) -> FV @@ -536,6 +535,5 @@ freeVars (Tick tickish expr) freeVars (Type ty) = (tyVarsOfType ty, AnnType ty) freeVars (Coercion co) = (tyCoVarsOfCo co, AnnCoercion co) -freeVars (Hole src) = (noFVs, AnnHole src) \end{code} diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs index c6725b3..7680bab 100644 --- a/compiler/coreSyn/CorePrep.lhs +++ b/compiler/coreSyn/CorePrep.lhs @@ -517,7 +517,6 @@ cpeRhsE env (Case scrut bndr ty alts) = do { (env2, bs') <- cpCloneBndrs env bs ; rhs' <- cpeBodyNF env2 rhs ; return (con, bs', rhs') } -cpeRhsE _env expr@(Hole src) = return (emptyFloats, expr) cvtLitInteger :: Id -> Integer -> CoreExpr -- Here we convert a literal Integer to the low-level diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs index aa61e03..a8de9c2 100644 --- a/compiler/coreSyn/CoreSubst.lhs +++ b/compiler/coreSyn/CoreSubst.lhs @@ -398,7 +398,6 @@ subst_expr subst expr go (Case scrut bndr ty alts) = Case (go scrut) bndr' (substTy subst ty) (map (go_alt subst') alts) where (subst', bndr') = substBndr subst bndr - go (Hole src) = Hole src go_alt subst (con, bndrs, rhs) = (con, bndrs', subst_expr subst' rhs) where @@ -959,7 +958,6 @@ simple_opt_expr' subst expr where e' = go e (subst', b') = subst_opt_bndr subst b - go (Hole src) = Hole src ---------------------- go_alt subst (con, bndrs, rhs) diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index 610ac7d..15db00f 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -272,7 +272,6 @@ data Expr b | Tick (Tickish Id) (Expr b) | Type Type | Coercion Coercion - | Hole Id deriving (Data, Typeable) -- | Type synonym for expressions that occur in function argument positions. @@ -1390,7 +1389,6 @@ data AnnExpr' bndr annot | AnnTick (Tickish Id) (AnnExpr bndr annot) | AnnType Type | AnnCoercion Coercion - | AnnHole Id -- | A clone of the 'Alt' type but allowing annotation at every tree node type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot) @@ -1425,7 +1423,6 @@ deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body) deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg) deAnnotate' (AnnCast e (_,co)) = Cast (deAnnotate e) co deAnnotate' (AnnTick tick body) = Tick tick (deAnnotate body) -deAnnotate' (AnnHole src) = Hole src deAnnotate' (AnnLet bind body) = Let (deAnnBind bind) (deAnnotate body) diff --git a/compiler/coreSyn/CoreTidy.lhs b/compiler/coreSyn/CoreTidy.lhs index 75a5135..e29c50c 100644 --- a/compiler/coreSyn/CoreTidy.lhs +++ b/compiler/coreSyn/CoreTidy.lhs @@ -68,7 +68,6 @@ tidyExpr _ (Lit lit) = Lit lit tidyExpr env (App f a) = App (tidyExpr env f) (tidyExpr env a) tidyExpr env (Tick t e) = Tick (tidyTickish env t) (tidyExpr env e) tidyExpr env (Cast e co) = Cast (tidyExpr env e) (tidyCo env co) -tidyExpr _ (Hole src) = Hole src tidyExpr env (Let b e) = tidyBind env b =: \ (env', b') -> diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs index 22aa84d..816d34e 100644 --- a/compiler/coreSyn/CoreUnfold.lhs +++ b/compiler/coreSyn/CoreUnfold.lhs @@ -378,7 +378,6 @@ sizeExpr bOMB_OUT_SIZE top_args expr size_up (Lam b e) | isId b = lamScrutDiscount (size_up e `addSizeN` 10) | otherwise = size_up e - size_up (Hole src) = sizeZero size_up (Let (NonRec binder rhs) body) = size_up rhs `addSizeNSD` size_up body `addSizeN` diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs index adf9e69..39910c0 100644 --- a/compiler/coreSyn/PprCore.lhs +++ b/compiler/coreSyn/PprCore.lhs @@ -228,8 +228,6 @@ ppr_expr add_par (Let bind expr) ppr_expr add_par (Tick tickish expr) = add_par (sep [ppr tickish, pprCoreExpr expr]) -ppr_expr _ (Hole _) = text "__" - pprCoreAlt :: OutputableBndr a => (AltCon, [a] , Expr a) -> SDoc pprCoreAlt (con, args, rhs) = hang (ppr_case_pat con args <+> arrow) 2 (pprCoreExpr rhs) diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs index f4f598d..d722964 100644 --- a/compiler/ghci/ByteCodeGen.lhs +++ b/compiler/ghci/ByteCodeGen.lhs @@ -541,8 +541,6 @@ schemeE d s p (AnnCase scrut bndr _ [(DEFAULT, [], rhs)]) schemeE d s p (AnnCase scrut bndr _ alts) = doCase d s p scrut bndr alts Nothing{-not an unboxed tuple-} -schemeE d s p e@(AnnHole src) = returnUnboxedAtom d s p e VoidArg - schemeE _ _ _ expr = pprPanic "ByteCodeGen.schemeE: unhandled case" (pprCoreExpr (deAnnotate' expr)) @@ -1281,8 +1279,6 @@ pushAtom _ _ (AnnLit lit) -- Get the addr on the stack, untaggedly return (unitOL (PUSH_UBX (Right addr) 1), 1) -pushAtom _ _ (AnnHole src) = return (unitOL (PUSH_PRIMOP RaiseOp), 1) - pushAtom _ _ expr = pprPanic "ByteCodeGen.pushAtom" (pprCoreExpr (deAnnotate (undefined, expr))) diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs index f626948..5a204f4 100644 --- a/compiler/simplCore/OccurAnal.lhs +++ b/compiler/simplCore/OccurAnal.lhs @@ -1290,8 +1290,6 @@ occAnal env (Let bind body) where env_body = trimOccEnv env (bindersOf bind) -occAnal _ expr@(Hole _) = (emptyDetails, expr) - occAnalArgs :: OccEnv -> [CoreExpr] -> (UsageDetails, [CoreExpr]) occAnalArgs env args = case mapAndUnzip (occAnal arg_env) args of { (arg_uds_s, args') -> diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index 0b86b90..df9013c 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -926,7 +926,6 @@ simplExprF1 env (Type ty) cont = ASSERT( contIsRhsOrArg cont ) rebuild env (Type (substTy env ty)) cont simplExprF1 env (App fun arg) cont = simplExprF env fun $ ApplyTo NoDup arg env cont -simplExprF1 env (Hole src) cont = rebuild env (Hole src) cont simplExprF1 env expr@(Lam {}) cont = simplLam env zapped_bndrs body cont _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
