From 3531e8daa56a178f3b8ec280fd660b29387da25f Mon Sep 17 00:00:00 2001 From: dnt Date: Thu, 19 Dec 1996 12:02:09 +0000 Subject: [PATCH] [project @ 1996-12-19 12:02:09 by dnt] Removed unused file --- ghc/compiler/coreSyn/NmbrCore.lhs | 163 ------------------------------------- 1 file changed, 163 deletions(-) delete mode 100644 ghc/compiler/coreSyn/NmbrCore.lhs diff --git a/ghc/compiler/coreSyn/NmbrCore.lhs b/ghc/compiler/coreSyn/NmbrCore.lhs deleted file mode 100644 index f00208d..0000000 --- a/ghc/compiler/coreSyn/NmbrCore.lhs +++ /dev/null @@ -1,163 +0,0 @@ -% -% (c) The AQUA Project, Glasgow University, 1996 -% -\section[NmbrCore]{Renumber Core for printing} - -\begin{code} -#include "HsVersions.h" - -module NmbrCore where - -IMP_Ubiq(){-uitous-} - -import PprEnv ( NmbrEnv ) -\end{code} - -\begin{code} -nmbrCoreBindings :: [CoreBinding] -> NmbrEnv -> (NmbrEnv, [CoreBinding]) - -nmbr_bind :: CoreBinding -> NmbrEnv -> (NmbrEnv, CoreBinding) -nmbr_expr :: CoreExpr -> NmbrEnv -> (NmbrEnv, CoreExpr) -nmbr_arg :: CoreArg -> NmbrEnv -> (NmbrEnv, CoreArg) - -nmbrCoreBindings nenv [] = (nenv, []) -nmbrCoreBindings nenv (b:bs) - = let - (new_nenv, new_b) = nmbr_bind nenv b - (fin_nenv, new_bs) = nmbrCoreBindings new_nenv bs - in - (fin_nenv, new_b : new_bs) - -nmbr_bind nenv (NonRec binder rhs) - -- remember, binder cannot appear in rhs - = let - (_, new_rhs) = nmbr_expr nenv rhs - (nenv2, new_binder) = addId nenv binder - in - (nenv2, NonRec new_binder new_rhs) - -nmbr_bind nenv (Rec binds) - = -- for letrec, we plug in new bindings BEFORE cloning rhss - let - (binders, rhss) = unzip binds - - (nenv2, new_binders) = mapAccumL addId nenv binders - - (_, new_rhss) = mapAndUnzip (nmbr_expr nenv2) rhss - in - returnUs (nenv2, Rec (zipEqual "nmbr_bind" new_binders new_rhss)) -\end{code} - -\begin{code} -nmbr_arg nenv (VarArg v) - = let - (nenv2, new_v) = nmbrId nenv v - in - (nenv2, VarArg new_v) - -nmbr_arg nenv (TyArg ty) - = let - (nenv2, new_ty) = nmbrType nenv ty - in - (nenv2, TyArg new_ty) - -nmbr_arg nenv (UsageArg use) - = let - (nenv2, new_use) = nmbrUsage nenv use - in - (nenv2, UsageArg new_use) -\end{code} - -\begin{code} -nmbr_expr :: NmbrEnv - -> TypeEnv - -> CoreExpr - -> UniqSM CoreExpr - -nmbr_expr nenv tenv orig_expr@(Var var) - = returnUs ( - case (lookupIdEnv nenv var) of - Nothing -> --false:ASSERT(toplevelishId var) (SIGH) - orig_expr - Just expr -> expr - ) - -nmbr_expr nenv tenv e@(Lit _) = returnUs e - -nmbr_expr nenv tenv (Con con as) - = mapUs (nmbr_arg nenv tenv) as `thenUs` \ new_as -> - mkCoCon con new_as - -nmbr_expr nenv tenv (Prim op as) - = mapUs (nmbr_arg nenv tenv) as `thenUs` \ new_as -> - do_PrimOp op `thenUs` \ new_op -> - mkCoPrim new_op new_as - where - do_PrimOp (CCallOp label is_asm may_gc arg_tys result_ty) - = let - new_arg_tys = map (applyTypeEnvToTy tenv) arg_tys - new_result_ty = applyTypeEnvToTy tenv result_ty - in - returnUs (CCallOp label is_asm may_gc new_arg_tys new_result_ty) - - do_PrimOp other_op = returnUs other_op - -nmbr_expr nenv tenv (Lam binder expr) - = dup_binder tenv binder `thenUs` \(new_binder, (old,new)) -> - let new_nenv = addOneToIdEnv nenv old new in - nmbr_expr new_nenv tenv expr `thenUs` \ new_expr -> - returnUs (Lam new_binder new_expr) - -nmbr_expr nenv tenv (App expr arg) - = nmbr_expr nenv tenv expr `thenUs` \ new_expr -> - nmbr_arg nenv tenv arg `thenUs` \ new_arg -> - mkCoApps new_expr [new_arg] -- ToDo: more efficiently? - -nmbr_expr nenv tenv (Case expr alts) - = nmbr_expr nenv tenv expr `thenUs` \ new_expr -> - do_alts nenv tenv alts `thenUs` \ new_alts -> - returnUs (Case new_expr new_alts) - where - do_alts nenv tenv (AlgAlts alts deflt) - = mapUs (do_boxed_alt nenv tenv) alts `thenUs` \ new_alts -> - do_default nenv tenv deflt `thenUs` \ new_deflt -> - returnUs (AlgAlts new_alts new_deflt) - where - do_boxed_alt nenv tenv (con, binders, expr) - = mapAndUnzipUs (dup_binder tenv) binders `thenUs` \ (new_binders, new_vmaps) -> - let new_nenv = growIdEnvList nenv new_vmaps in - nmbr_expr new_nenv tenv expr `thenUs` \ new_expr -> - returnUs (con, new_binders, new_expr) - - - do_alts nenv tenv (PrimAlts alts deflt) - = mapUs (do_unboxed_alt nenv tenv) alts `thenUs` \ new_alts -> - do_default nenv tenv deflt `thenUs` \ new_deflt -> - returnUs (PrimAlts new_alts new_deflt) - where - do_unboxed_alt nenv tenv (lit, expr) - = nmbr_expr nenv tenv expr `thenUs` \ new_expr -> - returnUs (lit, new_expr) - - do_default nenv tenv NoDefault = returnUs NoDefault - - do_default nenv tenv (BindDefault binder expr) - = dup_binder tenv binder `thenUs` \ (new_binder, (old, new)) -> - let new_nenv = addOneToIdEnv nenv old new in - nmbr_expr new_nenv tenv expr `thenUs` \ new_expr -> - returnUs (BindDefault new_binder new_expr) - -nmbr_expr nenv tenv (Let core_bind expr) - = nmbr_bind nenv tenv core_bind `thenUs` \ (new_bind, new_nenv) -> - -- and do the body of the let - nmbr_expr new_nenv tenv expr `thenUs` \ new_expr -> - returnUs (Let new_bind new_expr) - -nmbr_expr nenv tenv (SCC label expr) - = nmbr_expr nenv tenv expr `thenUs` \ new_expr -> - returnUs (SCC label new_expr) - -nmbr_expr nenv tenv (Coerce c ty expr) - = nmbr_expr nenv tenv expr `thenUs` \ new_expr -> - returnUs (Coerce c ty new_expr) -\end{code} -- 1.7.10.4