[project @ 1997-05-19 00:12:10 by sof]

[ghc-hetmet.git] / ghc / compiler / coreSyn / CoreSyn.lhs

diff --git a/ghc/compiler/coreSyn/CoreSyn.lhs b/ghc/compiler/coreSyn/CoreSyn.lhs
index 42830e9..6e28cf4 100644 (file)
--- a/ghc/compiler/coreSyn/CoreSyn.lhs
+++ b/ghc/compiler/coreSyn/CoreSyn.lhs
@@ -56,10 +56,16 @@ module CoreSyn (
 IMP_Ubiq(){-uitous-}
 
 import CostCentre      ( showCostCentre, CostCentre )
-import Id              ( idType, GenId{-instance Eq-} )
-import Type            ( isUnboxedType )
-import Usage           ( SYN_IE(UVar) )
+import Id              ( idType, GenId{-instance Eq-}, SYN_IE(Id) )
+import Type            ( isUnboxedType,GenType, SYN_IE(Type) )
+import TyVar           ( GenTyVar, SYN_IE(TyVar) )
+import Usage           ( SYN_IE(UVar),GenUsage,SYN_IE(Usage) )
 import Util            ( panic, assertPanic {-pprTrace:ToDo:rm-} )
+#if __GLASGOW_HASKELL__ >= 202
+import Literal          ( Literal )
+import BinderInfo       ( BinderInfo )
+import PrimOp           ( PrimOp )
+#endif
 \end{code}
 
 %************************************************************************
@@ -133,6 +139,7 @@ desugarer sets up constructors as applications of global @Vars@s.
 
      | Prim    PrimOp [GenCoreArg val_occ tyvar uvar]
                -- saturated primitive operation;
+
                -- comment on Cons applies here, too.
 \end{code}
 
@@ -380,14 +387,16 @@ collectBinders ::
   ([uvar], [tyvar], [val_bdr], GenCoreExpr val_bdr val_occ tyvar uvar)
 
 collectBinders expr
-  = (usages, tyvars, vals, body)
+  = case collectValBinders body1 of { (vals,body) -> (usages, tyvars, vals, body) }
   where
     (usages, tyvars, body1) = collectUsageAndTyBinders expr
-    (vals, body)           = collectValBinders body1
+--    (vals, body)         = collectValBinders body1
 
 
 collectUsageAndTyBinders expr
-  = usages expr []
+  = case usages expr [] of
+      ([],tyvars,body) -> ([],tyvars,body)
+      v                -> v
   where
     usages (Lam (UsageBinder u) body) uacc = usages body (u:uacc)
     usages other uacc
@@ -410,7 +419,9 @@ collectUsageAndTyBinders expr
 collectValBinders :: GenCoreExpr val_bdr val_occ tyvar uvar ->
                     ([val_bdr], GenCoreExpr val_bdr val_occ tyvar uvar)
 collectValBinders expr
-  = go [] expr
+  = case go [] expr of
+      ([],body) -> ([],body)
+      v         -> v
   where
     go acc (Lam (ValBinder v) b) = go (v:acc) b
     go acc body                 = (reverse acc, body)