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

diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index af75ec9..af19a58 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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