[project @ 2000-10-02 13:58:51 by sewardj]

Implement initial-state (emptyTy :: Ty) functions.

diff --git a/ghc/compiler/ghci/CmCompile.lhs b/ghc/compiler/ghci/CmCompile.lhs
index 2b32e05..e1d238b 100644 (file)
--- a/ghc/compiler/ghci/CmCompile.lhs
+++ b/ghc/compiler/ghci/CmCompile.lhs
@@ -5,11 +5,11 @@
 
 \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
@@ -21,7 +21,7 @@ import Outputable     ( SDoc )
 import CmFind          ( Finder )
 import CmSummarise     ( ModSummary )
 import CmStaticInfo    ( SI )
-import FiniteMap       ( FiniteMap )
+import FiniteMap       ( FiniteMap, emptyFM )
 
 import Module          ( Module )
 import RnMonad         ( Avails, GlobalRdrEnv, DeclsMap, 
@@ -61,8 +61,9 @@ data CompResult
    | 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.
@@ -77,6 +78,12 @@ data PCS = MkPCS PIT         -- Package interface table
 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 
@@ -118,4 +125,7 @@ data HoldingPen
         iRules :: IfaceRules
         -- Similar to instance decls, only for rules
      }
+
+emptyHoldingPen :: HoldingPen
+emptyHoldingPen = error "emptyHoldingPen:unimp"
 \end{code}

diff --git a/ghc/compiler/ghci/CmLink.lhs b/ghc/compiler/ghci/CmLink.lhs
index 311af33..4bd231e 100644 (file)
--- a/ghc/compiler/ghci/CmLink.lhs
+++ b/ghc/compiler/ghci/CmLink.lhs
@@ -15,7 +15,7 @@ import CmStaticInfo   ( PCI )
 import CmFind          ( Path, PkgName )
 import Module          ( Module )
 import Outputable      ( SDoc )
-import FiniteMap       ( FiniteMap )
+import FiniteMap       ( FiniteMap, emptyFM )
 import RdrName         ( RdrName )
 import Addr            ( Addr )
 
@@ -52,5 +52,6 @@ data Linkable
    | LP PkgName
 
 emptyPLS :: IO PLS
-emptyPLS = return (error "emptyPLS:unimp")
+emptyPLS = return (MkPLS { source_symtab = emptyFM, 
+                           object_symtab = emptyFM })
 \end{code}

diff --git a/ghc/compiler/ghci/CompManager.lhs b/ghc/compiler/ghci/CompManager.lhs
index de988cc..02f33ca 100644 (file)
--- a/ghc/compiler/ghci/CompManager.lhs
+++ b/ghc/compiler/ghci/CompManager.lhs
@@ -13,12 +13,13 @@ where
 #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 )
 
 
 
@@ -26,7 +27,7 @@ cmInit :: FLAGS
        -> PCI
        -> IO CmState
 cmInit flags pkginfo
-   = return (error "cmInit:unimp")
+   = emptyCmState flags pkginfo
 
 cmLoadModule :: CmState 
              -> ModName
@@ -55,6 +56,17 @@ data PCMS
           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
@@ -63,9 +75,24 @@ data CmState
              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
 
 
 

diff --git a/ghc/compiler/main/Main.lhs b/ghc/compiler/main/Main.lhs
index 78d1227..cf0ee0e 100644 (file)
--- a/ghc/compiler/main/Main.lhs
+++ b/ghc/compiler/main/Main.lhs
@@ -46,7 +46,10 @@ import BSD
 import IOExts          ( unsafePerformIO )
 import NativeInfo       ( os, arch )
 #endif
+#ifdef GHCI
 import StgInterp       ( runStgI )
+import CompManager
+#endif
 
 \end{code}
 

diff --git a/ghc/compiler/nativeGen/AsmRegAlloc.lhs b/ghc/compiler/nativeGen/AsmRegAlloc.lhs
index 02c5649..6349b44 100644 (file)
--- a/ghc/compiler/nativeGen/AsmRegAlloc.lhs
+++ b/ghc/compiler/nativeGen/AsmRegAlloc.lhs
@@ -10,6 +10,7 @@ module AsmRegAlloc ( runRegAllocate ) where
 
 import MachCode                ( InstrBlock )
 import MachMisc                ( Instr(..) )
+import PprMach         ( pprInstr )    -- Just for debugging
 import MachRegs
 import RegAllocInfo
 
@@ -65,7 +66,13 @@ runRegAllocate regs find_reserve_regs instrs
     --)
   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
@@ -199,7 +206,16 @@ doGeneralAlloc
 
 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