X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FMkExternalCore.lhs;h=fc49c2b17b2d26c0e9292658bb97711f7f54f1d3;hb=703ca1542c8e0983cc9d8eebce6e9f3dd3fd71e2;hp=ab1f12be25d108951cc242d349182374ea20fa43;hpb=9ffadf219cbc4f8ec57264786df936a3cee88aec;p=ghc-hetmet.git diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs index ab1f12b..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 @@ -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