-
-emitClosureCodeAndInfoTable :: ClosureInfo -> CmmFormals
- -> CmmAGraph -> FCode ()
-emitClosureCodeAndInfoTable cl_info args body
- = do { info <- mkCmmInfo cl_info
- ; emitProc info (infoLblToEntryLbl info_lbl) args body }
+-- When loading the free variables, a function closure pointer may be tagged,
+-- so we must take it into account.
+
+emitClosureProcAndInfoTable :: Bool -- top-level?
+ -> Id -- name of the closure
+ -> ClosureInfo -- lots of info abt the closure
+ -> [NonVoid Id] -- incoming arguments
+ -> ((LocalReg, [LocalReg]) -> FCode ()) -- function body
+ -> FCode ()
+emitClosureProcAndInfoTable top_lvl bndr cl_info args body
+ = do { let lf_info = closureLFInfo cl_info
+ -- Bind the binder itself, but only if it's not a top-level
+ -- binding. We need non-top let-bindings to refer to the
+ -- top-level binding, which this binding would incorrectly shadow.
+ ; node <- if top_lvl then return $ idToReg (NonVoid bndr)
+ else bindToReg (NonVoid bndr) lf_info
+ ; arg_regs <-
+ pprTrace "bindArgsToRegs" (ppr args) $
+ bindArgsToRegs args
+ ; emitClosureAndInfoTable cl_info (node : arg_regs) $ body (node, arg_regs)
+ }
+
+-- Data constructors need closures, but not with all the argument handling
+-- needed for functions. The shared part goes here.
+emitClosureAndInfoTable :: ClosureInfo -> [LocalReg] -> FCode () -> FCode ()
+emitClosureAndInfoTable cl_info args body
+ = do { info <- mkCmmInfo cl_info
+ ; blks <- getCode body
+ ; emitProc info (infoLblToEntryLbl info_lbl) args blks
+ }