Merging in the new codegen branch

[ghc-hetmet.git] / compiler / prelude / ForeignCall.lhs

diff --git a/compiler/prelude/ForeignCall.lhs b/compiler/prelude/ForeignCall.lhs
index 2c90a7d..27f5b4f 100644 (file)
--- a/compiler/prelude/ForeignCall.lhs
+++ b/compiler/prelude/ForeignCall.lhs
@@ -4,6 +4,13 @@
 \section[Foreign]{Foreign calls}
 
 \begin{code}
+{-# 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 ForeignCall (
        ForeignCall(..),
        Safety(..), playSafe, playThreadSafe,
@@ -17,9 +24,7 @@ module ForeignCall (
        withDNTypes
     ) where
 
-#include "HsVersions.h"
-
-import FastString      ( FastString, unpackFS )
+import FastString
 import Char            ( isAlphaNum )
 import Binary
 import Outputable
@@ -65,9 +70,9 @@ data Safety
   {-! derive: Binary !-}
 
 instance Outputable Safety where
-  ppr (PlaySafe False) = ptext SLIT("safe")
-  ppr (PlaySafe True)  = ptext SLIT("threadsafe")
-  ppr PlayRisky = ptext SLIT("unsafe")
+  ppr (PlaySafe False) = ptext (sLit "safe")
+  ppr (PlaySafe True)  = ptext (sLit "threadsafe")
+  ppr PlayRisky = ptext (sLit "unsafe")
 
 playSafe :: Safety -> Bool
 playSafe PlaySafe{} = True
@@ -111,7 +116,7 @@ data CCallTarget
 
 isDynamicTarget :: CCallTarget -> Bool
 isDynamicTarget DynamicTarget = True
-isDynamicTarget other        = False
+isDynamicTarget _             = False
 \end{code}
 
 
@@ -126,15 +131,18 @@ stdcall:  Caller allocates parameters, callee deallocates.
 ToDo: The stdcall calling convention is x86 (win32) specific,
 so perhaps we should emit a warning if it's being used on other
 platforms.
+ 
+See: http://www.programmersheaven.com/2/Calling-conventions
 
 \begin{code}
-data CCallConv = CCallConv | StdCallConv
+data CCallConv = CCallConv | StdCallConv | CmmCallConv
   deriving (Eq)
   {-! derive: Binary !-}
 
 instance Outputable CCallConv where
-  ppr StdCallConv = ptext SLIT("stdcall")
-  ppr CCallConv   = ptext SLIT("ccall")
+  ppr StdCallConv = ptext (sLit "stdcall")
+  ppr CCallConv   = ptext (sLit "ccall")
+  ppr CmmCallConv = ptext (sLit "C--")
 
 defaultCCallConv :: CCallConv
 defaultCCallConv = CCallConv