Fix fwrite$UNIX2003 symbols when cross-compiling for Tiger

[ghc-hetmet.git] / compiler / cmm / CmmBrokenBlock.hs

diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs
index b8ef5f9..526bdc1 100644 (file)
--- a/compiler/cmm/CmmBrokenBlock.hs
+++ b/compiler/cmm/CmmBrokenBlock.hs
@@ -1,3 +1,10 @@
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module CmmBrokenBlock (
   BrokenBlock(..),
   BlockEntryInfo(..),
@@ -64,11 +71,11 @@ data BlockEntryInfo
   = FunctionEntry              -- ^ Block is the beginning of a function
       CmmInfo                   -- ^ Function header info
       CLabel                    -- ^ The function name
-      CmmFormals                -- ^ Aguments to function
+      CmmFormalsWithoutKinds                -- ^ Aguments to function
                -- Only the formal parameters are live 
 
   | ContinuationEntry          -- ^ Return point of a function call
-      CmmFormals                -- ^ return values (argument to continuation)
+      CmmFormalsWithoutKinds                -- ^ return values (argument to continuation)
       C_SRT                     -- ^ SRT for the continuation's info table
       Bool                      -- ^ True <=> GC block so ignore stack size
                -- Live variables, other than 
@@ -115,7 +122,7 @@ f2(x, y) { // ProcPointEntry
 -}
 
 data ContFormat = ContFormat
-      CmmHintFormals            -- ^ return values (argument to continuation)
+      CmmFormals            -- ^ return values (argument to continuation)
       C_SRT                     -- ^ SRT for the continuation's info table
       Bool                      -- ^ True <=> GC block so ignore stack size
   deriving (Eq)
@@ -139,7 +146,7 @@ data FinalStmt
       BlockId                   -- ^ Target of the 'CmmGoto'
                                 -- (must be a 'ContinuationEntry')
       CmmCallTarget             -- ^ The function to call
-      CmmHintFormals                -- ^ Results from call
+      CmmFormals                -- ^ Results from call
                                 -- (redundant with ContinuationEntry)
       CmmActuals                -- ^ Arguments to call
       C_SRT                     -- ^ SRT for the continuation's info table
@@ -183,7 +190,7 @@ breakProc ::
                                 -- to create names of the new blocks with
     -> CmmInfo                  -- ^ Info table for the procedure
     -> CLabel                   -- ^ Name of the procedure
-    -> CmmFormals               -- ^ Parameters of the procedure
+    -> CmmFormalsWithoutKinds               -- ^ Parameters of the procedure
     -> [CmmBasicBlock]          -- ^ Blocks of the procecure
                                 -- (First block is the entry block)
     -> [BrokenBlock]
@@ -341,7 +348,7 @@ makeContinuationEntries formats
     case lookup ident formats of
       Nothing -> block
       Just (ContFormat formals srt is_gc) ->
-          BrokenBlock ident (ContinuationEntry (map fst formals) srt is_gc)
+          BrokenBlock ident (ContinuationEntry (map kindlessCmm formals) srt is_gc)
                       stmts targets exit
 
 adaptBlockToFormat :: [(BlockId, ContFormat)]
@@ -371,11 +378,11 @@ adaptBlockToFormat formats unique
                        target formals actuals srt ret is_gc
 
       adaptor_block = mk_adaptor_block adaptor_ident
-                  (ContinuationEntry (map fst formals) srt is_gc)
+                  (ContinuationEntry (map kindlessCmm formals) srt is_gc)
                   next format_formals
       adaptor_ident = BlockId unique
 
-      mk_adaptor_block :: BlockId -> BlockEntryInfo -> BlockId -> CmmHintFormals -> BrokenBlock
+      mk_adaptor_block :: BlockId -> BlockEntryInfo -> BlockId -> CmmFormals -> BrokenBlock
       mk_adaptor_block ident entry next formals =
           BrokenBlock ident entry [] [next] exit
               where
@@ -383,7 +390,8 @@ adaptBlockToFormat formats unique
                          (CmmLit (CmmLabel (mkReturnPtLabel (getUnique next))))
                          (map formal_to_actual format_formals)
 
-                formal_to_actual (reg, hint) = ((CmmReg (CmmLocal reg)), hint)
+                formal_to_actual (CmmKinded reg hint)
+                     = (CmmKinded (CmmReg (CmmLocal reg)) hint)
                 -- TODO: Check if NoHint is right.  We're
                 -- jumping to a C-- function not a foreign one
                 -- so it might always be right.