X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FMkExternalCore.lhs;h=fc49c2b17b2d26c0e9292658bb97711f7f54f1d3;hb=0c5a05841df790c3d6b8537debc3b18aa8da98c5;hp=717d3d8d9383f0b6b740a1da11bd7912cb20fa97;hpb=6084fb5517da34f65034370a3695e2af3b85ce2b;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs
index 717d3d8..fc49c2b 100644
--- a/compiler/coreSyn/MkExternalCore.lhs
+++ b/compiler/coreSyn/MkExternalCore.lhs
@@ -26,7 +26,6 @@ import Outputable
 import Encoding
 import ForeignCall
 import DynFlags
-import StaticFlags
 import FastString
 
 import IO
@@ -34,7 +33,7 @@ import Data.Char
 
 emitExternalCore :: DynFlags -> CgGuts -> IO ()
 emitExternalCore dflags cg_guts
- | opt_EmitExternalCore 
+ | dopt Opt_EmitExternalCore dflags
  = (do handle <- openFile corename WriteMode
        hPutStrLn handle (show (mkExternalCore cg_guts))      
        hClose handle)
@@ -65,16 +64,9 @@ mkExternalCore :: CgGuts -> C.Module
 -- implicit in the data type declaration itself
 mkExternalCore (CgGuts {cg_module=this_mod, cg_tycons = tycons, 
                         cg_binds = binds})
- -- Note that we flatten binds at the top level:
- -- every module is just a single recursive bag of declarations.
- -- Rationale: since modules can be mutually recursive, 
- -- there's not much reason to preserve dependency info within a module.
-  = C.Module mname tdefs (case flattenBinds binds of
-                          -- check for empty list so we don't create an
-                          -- empty Rec group
-                            [] -> []
-                            bs  -> [(runCoreM (make_vdef True
-                                      (Rec bs)) this_mod)])
+{- Note that modules can be mutually recursive, but even so, we
+   print out dependency information within each module. -}
+  = C.Module mname tdefs (runCoreM (mapM (make_vdef True) binds) this_mod)
   where
     mname  = make_mid this_mod
     tdefs  = foldr collect_tdefs [] tycons
@@ -136,7 +128,7 @@ make_exp (Var v) = do
   let vName = Var.varName v
   isLocal <- isALocal vName
   return $
-     case globalIdVarDetails v of
+     case idDetails v of
        FCallId (CCall (CCallSpec (StaticTarget nm) callconv _)) 
            -> C.External (unpackFS nm) (showSDoc (ppr callconv)) (make_ty (varType v))
        FCallId (CCall (CCallSpec DynamicTarget     callconv _)) 
@@ -149,7 +141,7 @@ make_exp (Var v) = do
        DataConWorkId _ -> C.Var (make_var_qid False vName)
        DataConWrapId _ -> C.Var (make_var_qid False vName)
        _ -> C.Var (make_var_qid isLocal vName)
-make_exp (Lit (MachLabel s _)) = return $ C.Label (unpackFS s)
+make_exp (Lit (MachLabel s _ _)) = return $ C.Label (unpackFS s)
 make_exp (Lit l) = return $ C.Lit (make_lit l)
 make_exp (App e (Type t)) = make_exp e >>= (\ b -> return $ C.Appt b (make_ty t))
 make_exp (App e1 e2) = do