[project @ 2001-10-03 13:58:13 by simonpj]

[ghc-hetmet.git] / ghc / compiler / codeGen / CgConTbls.lhs

diff --git a/ghc/compiler/codeGen/CgConTbls.lhs b/ghc/compiler/codeGen/CgConTbls.lhs
index 5a2b6be..5b862fd 100644 (file)
--- a/ghc/compiler/codeGen/CgConTbls.lhs
+++ b/ghc/compiler/codeGen/CgConTbls.lhs
@@ -9,16 +9,23 @@ module CgConTbls ( genStaticConBits ) where
 #include "HsVersions.h"
 
 import AbsCSyn
+import StgSyn
 import CgMonad
 
 import AbsCUtils       ( mkAbstractCs, mkAbsCStmts )
+import CostCentre      ( noCCS )
+import CgCon           ( cgTopRhsCon )
+import CgClosure       ( cgTopRhsClosure )
 import CgTailCall      ( performReturn, mkStaticAlgReturnCode )
-import ClosureInfo     ( layOutStaticConstr, layOutDynConstr, ClosureInfo )
-import DataCon         ( DataCon, dataConName, dataConRepArgTys, isNullaryDataCon )
+import ClosureInfo     ( layOutStaticConstr, layOutDynConstr, mkClosureLFInfo, ClosureInfo )
+import DataCon         ( DataCon, dataConName, dataConRepArgTys, dataConId, isNullaryDataCon )
+import Id              ( mkTemplateLocals )
 import Name            ( getOccName )
 import OccName         ( occNameUserString )
 import TyCon           ( tyConDataCons, isEnumerationTyCon, TyCon )
 import Type            ( typePrimRep )
+import BasicTypes      ( TopLevelFlag(..) )
+import Outputable
 \end{code}
 
 For every constructor we generate the following info tables:
@@ -75,19 +82,22 @@ genStaticConBits comp_info gen_tycons
     --       C labels are local to this module i.e. static
     --      since they may be duplicated in other modules
 
-    mkAbstractCs [ gen_for_tycon tc | tc <- gen_tycons ]
+    mkAbstractCs [ gen_for_tycon tc `mkAbsCStmts` enum_closure_table tc
+                | tc <- gen_tycons ]
   where
     gen_for_tycon :: TyCon -> AbstractC
-    gen_for_tycon tycon
-      = mkAbstractCs (map (genConInfo comp_info tycon) (tyConDataCons tycon)) 
-       `mkAbsCStmts` (
-         -- after the con decls, so we don't need to declare the constructor labels
-         if (isEnumerationTyCon tycon)
-           then CClosureTbl tycon
-           else AbsCNop
-       )
+    gen_for_tycon tycon = mkAbstractCs [ genConInfo comp_info data_con 
+                                      | data_con <- tyConDataCons tycon ] 
+
+    enum_closure_table tycon
+       | isEnumerationTyCon tycon = CClosureTbl tycon
+       | otherwise                = AbsCNop
+               -- Put the table after the data constructor decls, because the
+               -- datatype closure table (for enumeration types)
+               -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
 \end{code}
 
+
 %************************************************************************
 %*                                                                     *
 \subsection[CgConTbls-info-tables]{Generating info tables for constructors}
@@ -98,14 +108,14 @@ Generate the entry code, info tables, and (for niladic constructor) the
 static closure, for a constructor.
 
 \begin{code}
-genConInfo :: CompilationInfo -> TyCon -> DataCon -> AbstractC
+genConInfo :: CompilationInfo -> DataCon -> AbstractC
 
-genConInfo comp_info tycon data_con
-  = mkAbstractCs [
-                 CSplitMarker,
+genConInfo comp_info data_con
+  =    -- Order of things is to reduce forward references
+    mkAbstractCs [CSplitMarker,
                  closure_code,
-                 static_code]
-       -- Order of things is to reduce forward references
+                 static_code,
+                 wrkr_code]
   where
     (closure_info, body_code) = mkConCodeAndInfo data_con
 
@@ -114,10 +124,11 @@ genConInfo comp_info tycon data_con
     -- info-table contains the information we need.
     (static_ci,_) = layOutStaticConstr con_name data_con typePrimRep arg_tys
 
-    body       = (initC comp_info (
+    body       = initC comp_info (
                      profCtrC SLIT("TICK_ENT_CON") [CReg node] `thenC`
-                     body_code))
+                     body_code)
 
+    wrkr_code  = initC comp_info (cgWorker data_con `thenFC` \ _ -> returnFC ())
     con_descr  = occNameUserString (getOccName data_con)
 
     -- Don't need any dynamic closure code for zero-arity constructors
@@ -158,3 +169,27 @@ mkConCodeAndInfo con
        in
        (closure_info, body_code)
 \end{code}
+
+For a constructor C, make a binding
+
+       $wC = \x y -> $wC x y
+
+i.e. a curried constructor that allocates.  This means that we can treat
+the worker for a constructor like any other function in the rest of the compiler.
+
+\begin{code}
+cgWorker data_con
+  | isNullaryDataCon data_con
+  = cgTopRhsCon work_id data_con []
+
+  | otherwise
+  = cgTopRhsClosure work_id
+           noCCS noBinderInfo NoSRT
+           arg_ids rhs
+           lf_info
+  where
+    work_id = dataConId data_con
+    arg_ids = mkTemplateLocals (dataConRepArgTys data_con)
+    rhs     = StgConApp data_con [StgVarArg id | id <- arg_ids]
+    lf_info = mkClosureLFInfo work_id TopLevel [{-no fvs-}] ReEntrant arg_ids
+\end{code}