Commit 19e64b50 authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

Chagne newtype wrapper into worker

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
parent 35a557b0
......@@ -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
......
......@@ -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 &&
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment