Commit 77532735 authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

AsmCodeGen: Refactor worker in cmmNativeGens

Test Plan: Validate

Reviewers: austin, simonmar, michalt

Reviewed By: simonmar, michalt

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2736
parent 4d4e7a51
......@@ -416,7 +416,8 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs
-- | Do native code generation on all these cmms.
--
cmmNativeGens :: (Outputable statics, Outputable instr, Instruction instr)
cmmNativeGens :: forall statics instr jumpDest.
(Outputable statics, Outputable instr, Instruction instr)
=> DynFlags
-> Module -> ModLocation
-> NcgImpl statics instr jumpDest
......@@ -428,12 +429,15 @@ cmmNativeGens :: (Outputable statics, Outputable instr, Instruction instr)
-> Int
-> IO (NativeGenAcc statics instr, UniqSupply)
cmmNativeGens _ _ _ _ _ _ us [] ngs !_
= return (ngs, us)
cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap = go
where
go :: UniqSupply -> [RawCmmDecl] -> NativeGenAcc statics instr -> Int
-> IO (NativeGenAcc statics instr, UniqSupply)
cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap us
(cmm : cmms) ngs count
= do
go us [] ngs !_ =
return (ngs, us)
go us (cmm : cmms) ngs count = do
let fileIds = ngs_dwarfFiles ngs
(us', fileIds', native, imports, colorStats, linearStats)
<- {-# SCC "cmmNativeGen" #-}
......@@ -468,11 +472,10 @@ cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap us
, ngs_labels = ngs_labels ngs ++ labels'
, ngs_dwarfFiles = fileIds'
}
cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap us'
cmms ngs' (count + 1)
go us' cmms ngs' (count + 1)
where seqString [] = ()
seqString (x:xs) = x `seq` seqString xs
seqString [] = ()
seqString (x:xs) = x `seq` seqString xs
emitNativeCode :: DynFlags -> BufHandle -> SDoc -> IO ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment