[project @ 1996-06-05 06:44:31 by partain]

[ghc-hetmet.git] / ghc / compiler / simplCore / SATMonad.lhs

diff --git a/ghc/compiler/simplCore/SATMonad.lhs b/ghc/compiler/simplCore/SATMonad.lhs
index 265df48..029d856 100644 (file)
--- a/ghc/compiler/simplCore/SATMonad.lhs
+++ b/ghc/compiler/simplCore/SATMonad.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
 %
 %************************************************************************
 %*                                                                     *
@@ -7,9 +7,20 @@
 %*                                                                     *
 %************************************************************************
 
+96/03: We aren't using the static-argument transformation right now.
+
 \begin{code}
 #include "HsVersions.h"
 
+module SATMonad where
+
+IMP_Ubiq(){-uitous-}
+import Util            ( panic )
+
+junk_from_SATMonad = panic "SATMonad.junk"
+
+{- LATER: to end of file:
+
 module SATMonad (
        SATInfo(..), updSAEnv,
        SatM(..), initSAT, emptyEnvSAT,
@@ -20,7 +31,7 @@ module SATMonad (
     ) where
 
 import Type            ( mkTyVarTy, mkSigmaTy, TyVarTemplate,
-                         extractTyVarsFromTy, splitSigmaTy, splitTyArgs,
+                         splitSigmaTy, splitFunTy,
                          glueTyArgs, instantiateTy, TauType(..),
                          Class, ThetaType(..), SigmaType(..),
                          InstTyEnv(..)
@@ -130,12 +141,12 @@ newSATName id ty us env
   = case (getUnique us) of { unique ->
     (mkSysLocal new_str unique ty mkUnknownSrcLoc, env) }
   where
-    new_str = getOccurrenceName id _APPEND_ SLIT("_sat")
+    new_str = panic "SATMonad.newSATName (ToDo)" -- getOccName id _APPEND_ SLIT("_sat")
 
 getArgLists :: CoreExpr -> ([Arg Type],[Arg Id])
 getArgLists expr
   = let
-       (uvs, tvs, lambda_bounds, body) = digForLambdas expr
+       (uvs, tvs, lambda_bounds, body) = collectBinders expr
     in
     ([ Static (mkTyVarTy tv) | tv <- tvs ],
      [ Static v                     | v <- lambda_bounds ])
@@ -201,12 +212,12 @@ saTransform binder rhs
            -- this binder *will* get inlined but if it happen to be
            -- a top level binder it is never removed as dead code,
            -- therefore we have to remove that information (of it being
-           -- top-level or exported somehow.
+           -- top-level or exported somehow.)
            -- A better fix is to use binder directly but with the TopLevel
            -- tag (or Exported tag) modified.
            fake_binder = mkSysLocal
-                           (getOccurrenceName binder _APPEND_ SLIT("_fsat"))
-                           (getItsUnique binder)
+                           (getOccName binder _APPEND_ SLIT("_fsat"))
+                           (uniqueOf binder)
                            (idType binder)
                            mkUnknownSrcLoc
            rec_body = mkValLam non_static_args
@@ -229,7 +240,7 @@ saTransform binder rhs
       where
        -- get type info for the local function:
        (tv_tmpl, dict_tys, tau_ty) = (splitSigmaTy . idType) binder
-       (reg_arg_tys, res_type)     = splitTyArgs tau_ty
+       (reg_arg_tys, res_type)     = splitFunTy tau_ty
 
        -- now, we drop the ones that are
        -- static, that is, the ones we will not pass to the local function
@@ -250,4 +261,5 @@ dropStatics (_:args)            (t:ts) = t:dropStatics args ts
 isStatic :: Arg a -> Bool
 isStatic NotStatic = False
 isStatic _        = True
+-}
 \end{code}