remove empty dir

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

diff --git a/ghc/compiler/prelude/ForeignCall.lhs b/ghc/compiler/prelude/ForeignCall.lhs
index 0197d64..2c90a7d 100644 (file)
--- a/ghc/compiler/prelude/ForeignCall.lhs
+++ b/ghc/compiler/prelude/ForeignCall.lhs
@@ -1,5 +1,3 @@
-{-% DrIFT (Automatic class derivations for Haskell) v1.1 %-}
-{-% DrIFT (Automatic class derivations for Haskell) v1.1 %-}
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
@@ -10,21 +8,19 @@ module ForeignCall (
        ForeignCall(..),
        Safety(..), playSafe, playThreadSafe,
 
-       CExportSpec(..),
+       CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
        CCallSpec(..), 
-       CCallTarget(..), isDynamicTarget, isCasmTarget,
+       CCallTarget(..), isDynamicTarget,
        CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute,
 
        DNCallSpec(..), DNKind(..), DNType(..),
-       withDNTypes,
-
-       okToExposeFCall
+       withDNTypes
     ) where
 
 #include "HsVersions.h"
 
-import CStrings                        ( CLabelString, pprCLabelString )
-import FastString              ( FastString )
+import FastString      ( FastString, unpackFS )
+import Char            ( isAlphaNum )
 import Binary
 import Outputable
 \end{code}
@@ -110,16 +106,12 @@ The call target:
 data CCallTarget
   = StaticTarget  CLabelString  -- An "unboxed" ccall# to `fn'.
   | DynamicTarget              -- First argument (an Addr#) is the function pointer
-  | CasmTarget    CLabelString -- Inline C code (now seriously deprecated)
   deriving( Eq )
   {-! derive: Binary !-}
 
-isDynamicTarget, isCasmTarget :: CCallTarget -> Bool
+isDynamicTarget :: CCallTarget -> Bool
 isDynamicTarget DynamicTarget = True
 isDynamicTarget other        = False
-
-isCasmTarget (CasmTarget _) = True
-isCasmTarget other         = False
 \end{code}
 
 
@@ -157,10 +149,26 @@ calling convention (used by PprAbsC):
 
 \begin{code}
 ccallConvAttribute :: CCallConv -> String
-ccallConvAttribute StdCallConv = "__stdcall"
+ccallConvAttribute StdCallConv = "__attribute__((__stdcall__))"
 ccallConvAttribute CCallConv   = ""
 \end{code}
 
+\begin{code}
+type CLabelString = FastString         -- A C label, completely unencoded
+
+pprCLabelString :: CLabelString -> SDoc
+pprCLabelString lbl = ftext lbl
+
+isCLabelString :: CLabelString -> Bool -- Checks to see if this is a valid C label
+isCLabelString lbl 
+  = all ok (unpackFS lbl)
+  where
+    ok c = isAlphaNum c || c == '_' || c == '.'
+       -- The '.' appears in e.g. "foo.so" in the 
+       -- module part of a ExtName.  Maybe it should be separate
+\end{code}
+
+
 Printing into C files:
 
 \begin{code}
@@ -178,7 +186,6 @@ instance Outputable CCallSpec where
 
       ppr_fun DynamicTarget     = text "__dyn_ccall" <> gc_suf <+> text "\"\""
       ppr_fun (StaticTarget fn) = text "__ccall"     <> gc_suf <+> pprCLabelString fn
-      ppr_fun (CasmTarget   fn) = text "__casm"      <> gc_suf <+> text "``" <> pprCLabelString fn <> text "''"
 \end{code}
 
 
@@ -251,13 +258,6 @@ instance Outputable DNCallSpec where
 %************************************************************************
 
 \begin{code}
-okToExposeFCall :: ForeignCall -> Bool
--- OK to unfold a Foreign Call in an interface file
--- Yes, unless it's a _casm_
-okToExposeFCall (CCall (CCallSpec target _ _)) = not (isCasmTarget target)
-okToExposeFCall other                                 = True
-\end{code}
-\begin{code}
 {-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-}
 instance Binary ForeignCall where
     put_ bh (CCall aa) = do
@@ -313,17 +313,12 @@ instance Binary CCallTarget where
            put_ bh aa
     put_ bh DynamicTarget = do
            putByte bh 1
-    put_ bh (CasmTarget ab) = do
-           putByte bh 2
-           put_ bh ab
     get bh = do
            h <- getByte bh
            case h of
              0 -> do aa <- get bh
                      return (StaticTarget aa)
-             1 -> do return DynamicTarget
-             _ -> do ab <- get bh
-                     return (CasmTarget ab)
+             _ -> do return DynamicTarget
 
 instance Binary CCallConv where
     put_ bh CCallConv = do