Mon Sep 18 17:17:57 EDT 2006 Manuel M T Chakravarty <chak@cse.unsw.edu.au>
* Chagne newtype wrapper into worker
Sun Aug 6 20:55:30 EDT 2006 Manuel M T Chakravarty <chak@cse.unsw.edu.au>
* Chagne newtype wrapper into worker
Wed Aug 2 11:54:28 EDT 2006 kevind@bu.edu
- strict args may be flattened
The worker is very like a primop, in that it has no binding.
- 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
The "wrapper Id", $WC, whose type is exactly what it looks like
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 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.
- = 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
-- 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
-- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments
-- The worker takes dcRepArgTys as its arguments
-- If the worker is absent, dcRepArgTys is the same as dcOrigArgTys
-- 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)
-- Not only is this efficient,
-- but it also ensures that the wrapper is replaced
-- by the worker (becuase it *is* the wroker)
dataConWorkId :: DataCon -> Id
dataConWorkId dc = case dcIds dc of
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
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
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
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
dataConFieldLabels :: DataCon -> [FieldLabel]
dataConFieldLabels = dcFields
mkDataConIds :: Name -> Name -> DataCon -> DataConIds
mkDataConIds wrap_name wkr_name data_con
| isNewTyCon tycon
mkDataConIds :: Name -> Name -> DataCon -> DataConIds
mkDataConIds wrap_name wkr_name data_con
| isNewTyCon tycon
+ = DCIds Nothing nt_work_id -- Newtype, only has a worker
| any isMarkedStrict all_strict_marks -- Algebraic, needs wrapper
|| not (null eq_spec)
| 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
| otherwise -- Algebraic, no wrapper
where
(univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys) = dataConFullSig data_con
tycon = dataConTyCon data_con
where
(univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys) = dataConFullSig data_con
tycon = dataConTyCon data_con
-- that is, not unboxed tuples or [non-recursive] newtypes
----------- Wrappers for newtypes --------------
-- 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 &&
`setArityInfo` 1 -- Arity 1
`setUnfoldingInfo` newtype_unf
newtype_unf = ASSERT( isVanillaDataCon data_con &&
mkLams :: [b] -> Expr b -> Expr b
mkLit lit = Lit lit
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
mkLams binders body = foldr Lam body binders
mkLets binds body = foldr Let body binds