[project @ 2002-07-03 15:15:24 by sof]

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

diff --git a/ghc/compiler/prelude/ForeignCall.lhs b/ghc/compiler/prelude/ForeignCall.lhs
index 6be1b5e..81d5705 100644 (file)
--- a/ghc/compiler/prelude/ForeignCall.lhs
+++ b/ghc/compiler/prelude/ForeignCall.lhs
@@ -1,3 +1,5 @@
+{-% 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
 %
@@ -22,6 +24,7 @@ module ForeignCall (
 
 import CStrings                ( CLabelString, pprCLabelString )
 import FastString      ( FastString )
+import Binary
 import Outputable
 \end{code}
 
@@ -38,6 +41,7 @@ data ForeignCall
   | DNCall     DNCallSpec
   deriving( Eq )               -- We compare them when seeing if an interface
                                -- has changed (for versioning purposes)
+  {-! derive: Binary !-}
 
 -- We may need more clues to distinguish foreign calls
 -- but this simple printer will do for now
@@ -61,6 +65,7 @@ data Safety
                        -- without interacting with the runtime system at all
   deriving( Eq, Show )
        -- Show used just for Show Lex.Token, I think
+  {-! derive: Binary !-}
 
 instance Outputable Safety where
   ppr (PlaySafe False) = ptext SLIT("safe")
@@ -88,12 +93,14 @@ data CExportSpec
   = CExportStatic              -- foreign export ccall foo :: ty
        CLabelString            -- C Name of exported function
        CCallConv
+  {-! derive: Binary !-}
 
 data CCallSpec
   =  CCallSpec CCallTarget     -- What to call
                CCallConv       -- Calling convention to use.
                Safety
   deriving( Eq )
+  {-! derive: Binary !-}
 \end{code}
 
 The call target:
@@ -104,6 +111,7 @@ data CCallTarget
   | 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 DynamicTarget = True
@@ -128,7 +136,8 @@ platforms.
 
 \begin{code}
 data CCallConv = CCallConv | StdCallConv
-              deriving (Eq)
+  deriving (Eq)
+  {-! derive: Binary !-}
 
 instance Outputable CCallConv where
   ppr StdCallConv = ptext SLIT("stdcall")
@@ -180,10 +189,11 @@ instance Outputable CCallSpec where
 
 \begin{code}
 data DNCallSpec = DNCallSpec FastString
-               deriving (Eq)
+  deriving (Eq)
+  {-! derive: Binary !-}
 
 instance Outputable DNCallSpec where
-  ppr (DNCallSpec s) = char '"' <> ptext s <> char '"'
+  ppr (DNCallSpec s) = char '"' <> ftext s <> char '"'
 \end{code}
 
 
@@ -201,3 +211,92 @@ okToExposeFCall :: ForeignCall -> Bool
 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
+           putByte bh 0
+           put_ bh aa
+    put_ bh (DNCall ab) = do
+           putByte bh 1
+           put_ bh ab
+    get bh = do
+           h <- getByte bh
+           case h of
+             0 -> do aa <- get bh
+                     return (CCall aa)
+             _ -> do ab <- get bh
+                     return (DNCall ab)
+
+instance Binary Safety where
+    put_ bh (PlaySafe aa) = do
+           putByte bh 0
+           put_ bh aa
+    put_ bh PlayRisky = do
+           putByte bh 1
+    get bh = do
+           h <- getByte bh
+           case h of
+             0 -> do aa <- get bh
+                     return (PlaySafe aa)
+             _ -> do return PlayRisky
+
+instance Binary CExportSpec where
+    put_ bh (CExportStatic aa ab) = do
+           put_ bh aa
+           put_ bh ab
+    get bh = do
+         aa <- get bh
+         ab <- get bh
+         return (CExportStatic aa ab)
+
+instance Binary CCallSpec where
+    put_ bh (CCallSpec aa ab ac) = do
+           put_ bh aa
+           put_ bh ab
+           put_ bh ac
+    get bh = do
+         aa <- get bh
+         ab <- get bh
+         ac <- get bh
+         return (CCallSpec aa ab ac)
+
+instance Binary CCallTarget where
+    put_ bh (StaticTarget aa) = do
+           putByte bh 0
+           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)
+
+instance Binary CCallConv where
+    put_ bh CCallConv = do
+           putByte bh 0
+    put_ bh StdCallConv = do
+           putByte bh 1
+    get bh = do
+           h <- getByte bh
+           case h of
+             0 -> do return CCallConv
+             _ -> do return StdCallConv
+
+instance Binary DNCallSpec where
+    put_ bh (DNCallSpec aa) = do
+           put_ bh aa
+    get bh = do
+         aa <- get bh
+         return (DNCallSpec aa)
+
+--  Imported from other files :-
+
+\end{code}