X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FForeignCall.lhs;fp=compiler%2Fprelude%2FForeignCall.lhs;h=e2f5320e9b742e2a10dc5c29c9a5917a4ca555f7;hp=a6047a57a0b556cf389b347584217cd89fec6cf3;hb=1fede4bc9501744bf2269ce2a4cb9fb735969caa;hpb=dd849158c84941f5e3714dd4df24e467854f0d91 diff --git a/compiler/prelude/ForeignCall.lhs b/compiler/prelude/ForeignCall.lhs index a6047a5..e2f5320 100644 --- a/compiler/prelude/ForeignCall.lhs +++ b/compiler/prelude/ForeignCall.lhs @@ -19,9 +19,6 @@ module ForeignCall ( CCallSpec(..), CCallTarget(..), isDynamicTarget, CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute, - - DNCallSpec(..), DNKind(..), DNType(..), - withDNTypes ) where import FastString @@ -39,18 +36,14 @@ import Data.Char %************************************************************************ \begin{code} -data ForeignCall - = CCall CCallSpec - | DNCall DNCallSpec - deriving( Eq ) -- We compare them when seeing if an interface - -- has changed (for versioning purposes) +newtype ForeignCall = CCall CCallSpec + deriving Eq {-! derive: Binary !-} -- We may need more clues to distinguish foreign calls -- but this simple printer will do for now instance Outputable ForeignCall where ppr (CCall cc) = ppr cc - ppr (DNCall dn) = ppr dn \end{code} @@ -69,7 +62,7 @@ data Safety | PlayRisky -- None of the above can happen; the call will return -- without interacting with the runtime system at all - deriving( Eq, Show ) + deriving ( Eq, Show ) -- Show used just for Show Lex.Token, I think {-! derive: Binary !-} @@ -200,68 +193,6 @@ instance Outputable CCallSpec where %************************************************************************ %* * -\subsubsection{.NET interop} -%* * -%************************************************************************ - -\begin{code} -data DNCallSpec = - DNCallSpec Bool -- True => static method/field - DNKind -- what type of access - String -- assembly - String -- fully qualified method/field name. - [DNType] -- argument types. - DNType -- result type. - deriving ( Eq ) - {-! derive: Binary !-} - -data DNKind - = DNMethod - | DNField - | DNConstructor - deriving ( Eq ) - {-! derive: Binary !-} - -data DNType - = DNByte - | DNBool - | DNChar - | DNDouble - | DNFloat - | DNInt - | DNInt8 - | DNInt16 - | DNInt32 - | DNInt64 - | DNWord8 - | DNWord16 - | DNWord32 - | DNWord64 - | DNPtr - | DNUnit - | DNObject - | DNString - deriving ( Eq ) - {-! derive: Binary !-} - -withDNTypes :: DNCallSpec -> [DNType] -> DNType -> DNCallSpec -withDNTypes (DNCallSpec isStatic k assem nm _ _) argTys resTy - = DNCallSpec isStatic k assem nm argTys resTy - -instance Outputable DNCallSpec where - ppr (DNCallSpec isStatic kind ass nm _ _ ) - = char '"' <> - (if isStatic then text "static" else empty) <+> - (text (case kind of { DNMethod -> "method" ; DNField -> "field"; DNConstructor -> "ctor" })) <+> - (if null ass then char ' ' else char '[' <> text ass <> char ']') <> - text nm <> - char '"' -\end{code} - - - -%************************************************************************ -%* * \subsubsection{Misc} %* * %************************************************************************ @@ -269,19 +200,8 @@ instance Outputable DNCallSpec where \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) + put_ bh (CCall aa) = put_ bh aa + get bh = do aa <- get bh; return (CCall aa) instance Binary Safety where put_ bh (PlaySafe aa) = do @@ -342,94 +262,4 @@ instance Binary CCallConv where 0 -> do return CCallConv 1 -> do return StdCallConv _ -> do return PrimCallConv - -instance Binary DNCallSpec where - put_ bh (DNCallSpec isStatic kind ass nm _ _) = do - put_ bh isStatic - put_ bh kind - put_ bh ass - put_ bh nm - get bh = do - isStatic <- get bh - kind <- get bh - ass <- get bh - nm <- get bh - return (DNCallSpec isStatic kind ass nm [] undefined) - -instance Binary DNKind where - put_ bh DNMethod = do - putByte bh 0 - put_ bh DNField = do - putByte bh 1 - put_ bh DNConstructor = do - putByte bh 2 - get bh = do - h <- getByte bh - case h of - 0 -> do return DNMethod - 1 -> do return DNField - _ -> do return DNConstructor - -instance Binary DNType where - put_ bh DNByte = do - putByte bh 0 - put_ bh DNBool = do - putByte bh 1 - put_ bh DNChar = do - putByte bh 2 - put_ bh DNDouble = do - putByte bh 3 - put_ bh DNFloat = do - putByte bh 4 - put_ bh DNInt = do - putByte bh 5 - put_ bh DNInt8 = do - putByte bh 6 - put_ bh DNInt16 = do - putByte bh 7 - put_ bh DNInt32 = do - putByte bh 8 - put_ bh DNInt64 = do - putByte bh 9 - put_ bh DNWord8 = do - putByte bh 10 - put_ bh DNWord16 = do - putByte bh 11 - put_ bh DNWord32 = do - putByte bh 12 - put_ bh DNWord64 = do - putByte bh 13 - put_ bh DNPtr = do - putByte bh 14 - put_ bh DNUnit = do - putByte bh 15 - put_ bh DNObject = do - putByte bh 16 - put_ bh DNString = do - putByte bh 17 - - get bh = do - h <- getByte bh - case h of - 0 -> return DNByte - 1 -> return DNBool - 2 -> return DNChar - 3 -> return DNDouble - 4 -> return DNFloat - 5 -> return DNInt - 6 -> return DNInt8 - 7 -> return DNInt16 - 8 -> return DNInt32 - 9 -> return DNInt64 - 10 -> return DNWord8 - 11 -> return DNWord16 - 12 -> return DNWord32 - 13 -> return DNWord64 - 14 -> return DNPtr - 15 -> return DNUnit - 16 -> return DNObject - 17 -> return DNString - --- Imported from other files :- - \end{code}