From 19e64b50409a331ddf816cb4c7f33d646dabd43a Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Wed, 20 Sep 2006 18:17:22 +0000 Subject: [PATCH] Chagne newtype wrapper into worker Mon Sep 18 17:17:57 EDT 2006 Manuel M T Chakravarty * Chagne newtype wrapper into worker Sun Aug 6 20:55:30 EDT 2006 Manuel M T Chakravarty * Chagne newtype wrapper into worker Wed Aug 2 11:54:28 EDT 2006 kevind@bu.edu --- compiler/basicTypes/DataCon.lhs | 26 ++++++++++---------------- compiler/basicTypes/MkId.lhs | 10 +++++----- compiler/coreSyn/CoreSyn.lhs | 4 +--- 3 files changed, 16 insertions(+), 24 deletions(-) diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs index af75ec9..af19a58 100644 --- a/compiler/basicTypes/DataCon.lhs +++ b/compiler/basicTypes/DataCon.lhs @@ -111,7 +111,6 @@ The data con has one or two Ids associated with it: - strict args may be flattened The worker is very like a primop, in that it has no binding. - Newtypes have no worker Id The "wrapper Id", $WC, whose type is exactly what it looks like @@ -119,7 +118,7 @@ The data con has one or two Ids associated with it: and it gets a top-level binding like any other function. The wrapper Id isn't generated for a data type if the worker - and wrapper are identical. It's always generated for a newtype. + and wrapper are identical. @@ -308,10 +307,9 @@ data DataCon } data DataConIds - = NewDC Id -- Newtypes have only a wrapper, but no worker - | AlgDC (Maybe Id) Id -- Algebraic data types always have a worker, and + = DCIds (Maybe Id) Id -- Algebraic data types always have a worker, and -- may or may not have a wrapper, depending on whether - -- the wrapper does anything. + -- the wrapper does anything. Newtypes just have a worker -- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments @@ -319,7 +317,7 @@ data DataConIds -- The worker takes dcRepArgTys as its arguments -- If the worker is absent, dcRepArgTys is the same as dcOrigArgTys - -- The 'Nothing' case of AlgDC is important + -- The 'Nothing' case of DCIds is important -- Not only is this efficient, -- but it also ensures that the wrapper is replaced -- by the worker (becuase it *is* the wroker) @@ -496,28 +494,24 @@ dataConTheta = dcTheta dataConWorkId :: DataCon -> Id dataConWorkId dc = case dcIds dc of - AlgDC _ wrk_id -> wrk_id - NewDC _ -> pprPanic "dataConWorkId" (ppr dc) + DCIds _ wrk_id -> wrk_id dataConWrapId_maybe :: DataCon -> Maybe Id -- Returns Nothing if there is no wrapper for an algebraic data con -- and also for a newtype (whose constructor is inlined compulsorily) dataConWrapId_maybe dc = case dcIds dc of - AlgDC mb_wrap _ -> mb_wrap - NewDC wrap -> Nothing + DCIds mb_wrap _ -> mb_wrap dataConWrapId :: DataCon -> Id -- Returns an Id which looks like the Haskell-source constructor dataConWrapId dc = case dcIds dc of - AlgDC (Just wrap) _ -> wrap - AlgDC Nothing wrk -> wrk -- worker=wrapper - NewDC wrap -> wrap + DCIds (Just wrap) _ -> wrap + DCIds Nothing wrk -> wrk -- worker=wrapper dataConImplicitIds :: DataCon -> [Id] dataConImplicitIds dc = case dcIds dc of - AlgDC (Just wrap) work -> [wrap,work] - AlgDC Nothing work -> [work] - NewDC wrap -> [wrap] + DCIds (Just wrap) work -> [wrap,work] + DCIds Nothing work -> [work] dataConFieldLabels :: DataCon -> [FieldLabel] dataConFieldLabels = dcFields diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs index 52aff52..93369f5 100644 --- a/compiler/basicTypes/MkId.lhs +++ b/compiler/basicTypes/MkId.lhs @@ -192,14 +192,14 @@ Notice that mkDataConIds :: Name -> Name -> DataCon -> DataConIds mkDataConIds wrap_name wkr_name data_con | isNewTyCon tycon - = NewDC nt_wrap_id + = DCIds Nothing nt_work_id -- Newtype, only has a worker | any isMarkedStrict all_strict_marks -- Algebraic, needs wrapper || not (null eq_spec) - = AlgDC (Just alg_wrap_id) wrk_id + = DCIds (Just alg_wrap_id) wrk_id | otherwise -- Algebraic, no wrapper - = AlgDC Nothing wrk_id + = DCIds Nothing wrk_id where (univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys) = dataConFullSig data_con tycon = dataConTyCon data_con @@ -257,8 +257,8 @@ mkDataConIds wrap_name wkr_name data_con -- that is, not unboxed tuples or [non-recursive] newtypes ----------- Wrappers for newtypes -------------- - nt_wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty nt_wrap_info - nt_wrap_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo + nt_work_id = mkGlobalId (DataConWrapId data_con) wkr_name wrap_ty nt_work_info + nt_work_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo `setArityInfo` 1 -- Arity 1 `setUnfoldingInfo` newtype_unf newtype_unf = ASSERT( isVanillaDataCon data_con && diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index 29b1ce4..3db1a33 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -442,9 +442,7 @@ mkLets :: [Bind b] -> Expr b -> Expr b mkLams :: [b] -> Expr b -> Expr b mkLit lit = Lit lit -mkConApp con args - | isNewTyCon (dataConTyCon con) = mkApps (Var (dataConWrapId con)) args - | otherwise = mkApps (Var (dataConWorkId con)) args +mkConApp con args = mkApps (Var (dataConWorkId con)) args mkLams binders body = foldr Lam body binders mkLets binds body = foldr Let body binds -- 1.7.10.4