Implement initial-state (emptyTy :: Ty) functions.
\begin{code}
module CmCompile ( cmCompile,
- ModDetails, -- abstract
- ModIFace, -- abstract
- PCS, -- abstract
- HST, -- not abstract (CM needs to see it)
- HIT, -- ditto
+ ModDetails, -- abstract
+ ModIFace, -- abstract
+ PCS, emptyPCS, -- abstract
+ HST, -- not abstract (CM needs to see it)
+ HIT, -- ditto
CompResult(..)
)
where
import CmFind ( Finder )
import CmSummarise ( ModSummary )
import CmStaticInfo ( SI )
-import FiniteMap ( FiniteMap )
+import FiniteMap ( FiniteMap, emptyFM )
import Module ( Module )
import RnMonad ( Avails, GlobalRdrEnv, DeclsMap,
| CompErrs PCS -- updated PCS
[SDoc] -- warnings and errors
-newPCS :: IO PCS
-newPCS = return (error "newPCS:unimp")
+emptyPCS :: IO PCS
+emptyPCS = return (MkPCS emptyPIT emptyPST emptyHoldingPen)
+
-- These two are only here to avoid recursion between CmCompile and
-- CompManager. They really ought to be in the latter.
type PIT = FiniteMap Module ModIFace
type PST = FiniteMap Module ModDetails
+emptyPIT :: PIT
+emptyPIT = emptyFM
+
+emptyPST :: PST
+emptyPST = emptyFM
+
-- ModIFace is nearly the same as RnMonad.ParsedIface.
-- Right now it's identical :)
data ModIFace
iRules :: IfaceRules
-- Similar to instance decls, only for rules
}
+
+emptyHoldingPen :: HoldingPen
+emptyHoldingPen = error "emptyHoldingPen:unimp"
\end{code}
import CmFind ( Path, PkgName )
import Module ( Module )
import Outputable ( SDoc )
-import FiniteMap ( FiniteMap )
+import FiniteMap ( FiniteMap, emptyFM )
import RdrName ( RdrName )
import Addr ( Addr )
| LP PkgName
emptyPLS :: IO PLS
-emptyPLS = return (error "emptyPLS:unimp")
+emptyPLS = return (MkPLS { source_symtab = emptyFM,
+ object_symtab = emptyFM })
\end{code}
#include "HsVersions.h"
import Outputable ( SDoc )
+import FiniteMap ( emptyFM )
import CmStaticInfo ( FLAGS, PCI, SI, mkSI )
-import CmFind ( Finder, ModName )
+import CmFind ( Finder, newFinder, ModName )
import CmSummarise ( )
-import CmCompile ( PCS, HST, HIT )
-import CmLink ( PLS, HValue, Linkable )
+import CmCompile ( PCS, emptyPCS, HST, HIT )
+import CmLink ( PLS, emptyPLS, HValue, Linkable )
-> PCI
-> IO CmState
cmInit flags pkginfo
- = return (error "cmInit:unimp")
+ = emptyCmState flags pkginfo
cmLoadModule :: CmState
-> ModName
UI -- the unlinked images
MG -- the module graph
+emptyPCMS :: PCMS
+emptyPCMS = PCMS emptyHST emptyHIT emptyUI emptyMG
+
+emptyHIT :: HIT
+emptyHIT = emptyFM
+
+emptyHST :: HST
+emptyHST = emptyFM
+
+
+
-- Persistent state for the entire system
data CmState
= CmState PCMS -- CM's persistent state
SI -- static info, never changes
Finder -- the module finder
+emptyCmState :: FLAGS -> PCI -> IO CmState
+emptyCmState flags pci
+ = do let pcms = emptyPCMS
+ pcs <- emptyPCS
+ pls <- emptyPLS
+ let si = mkSI flags pci
+ finder <- newFinder pci
+ return (CmState pcms pcs pls si finder)
+
-- CM internal types
type UI = [Linkable] -- the unlinked images (should be a set, really)
+emptyUI :: UI
+emptyUI = []
+
+
data MG = MG -- the module graph
+emptyMG :: MG
+emptyMG = MG
import IOExts ( unsafePerformIO )
import NativeInfo ( os, arch )
#endif
+#ifdef GHCI
import StgInterp ( runStgI )
+import CompManager
+#endif
\end{code}
import MachCode ( InstrBlock )
import MachMisc ( Instr(..) )
+import PprMach ( pprInstr ) -- Just for debugging
import MachRegs
import RegAllocInfo
--)
where
tryGeneral []
- = error "nativeGen: spilling failed. Workaround: compile with -fvia-C.\n"
+ = pprPanic "nativeGen: spilling failed. Workaround: compile with -fvia-C.\n"
+ ( (text "reserves = " <> ppr reserves)
+ $$
+ (text "code = ")
+ $$
+ (vcat (map pprInstr flatInstrs))
+ )
tryGeneral (resv:resvs)
= case generalAlloc resv of
Just success -> success
doGeneralAlloc all_regs reserve_regs instrs
-- succeeded without spilling
- | prespill_ok = Just prespill_insns
+ | --trace (showSDoc (
+ -- text "allocating with these regs" <+> ppr prespill_regs
+ -- $$
+ -- text "giving code"
+ -- $$
+ -- vcat (map pprInstr prespill_insns)
+ --))
+ prespill_ok
+ = Just prespill_insns
+
-- failed, and no spill regs avail, so pointless to attempt spilling
| null reserve_regs = Nothing
-- success after spilling