[project @ 1996-12-19 09:10:02 by simonpj]
[ghc-hetmet.git] / ghc / compiler / simplCore / SATMonad.lhs
index 1b6b20c..36295df 100644 (file)
@@ -14,7 +14,7 @@
 
 module SATMonad where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 import Util            ( panic )
 
 junk_from_SATMonad = panic "SATMonad.junk"
@@ -31,14 +31,13 @@ module SATMonad (
     ) where
 
 import Type            ( mkTyVarTy, mkSigmaTy, TyVarTemplate,
-                         splitSigmaTy, splitTyArgs,
-                         glueTyArgs, instantiateTy, TauType(..),
-                         Class, ThetaType(..), SigmaType(..),
+                         splitSigmaTy, splitFunTy,
+                         glueTyArgs, instantiateTy, SYN_IE(TauType),
+                         Class, SYN_IE(ThetaType), SYN_IE(SigmaType),
                          InstTyEnv(..)
                        )
 import Id              ( mkSysLocal, idType )
-import Maybes          ( Maybe(..) )
-import SrcLoc          ( SrcLoc, mkUnknownSrcLoc )
+import SrcLoc          ( SrcLoc, noSrcLoc )
 import UniqSupply
 import Util
 
@@ -139,9 +138,9 @@ getSATInfo var us env
 newSATName :: Id -> Type -> SatM Id
 newSATName id ty us env
   = case (getUnique us) of { unique ->
-    (mkSysLocal new_str unique ty mkUnknownSrcLoc, env) }
+    (mkSysLocal new_str unique ty noSrcLoc, env) }
   where
-    new_str = panic "SATMonad.newSATName (ToDo)" -- getOccName id _APPEND_ SLIT("_sat")
+    new_str = getOccName id _APPEND_ SLIT("_sat")
 
 getArgLists :: CoreExpr -> ([Arg Type],[Arg Id])
 getArgLists expr
@@ -217,9 +216,9 @@ saTransform binder rhs
            -- tag (or Exported tag) modified.
            fake_binder = mkSysLocal
                            (getOccName binder _APPEND_ SLIT("_fsat"))
-                           (getItsUnique binder)
+                           (uniqueOf binder)
                            (idType binder)
-                           mkUnknownSrcLoc
+                           noSrcLoc
            rec_body = mkValLam non_static_args
                               ( Let (NonRec fake_binder nonrec_rhs)
                                 {-in-} (dropArgs rhs))
@@ -240,7 +239,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