Modules: Types (#13009)

Update Haddock submodule

Metric Increase:
   haddock.compiler

1 files changed, 0 insertions, 348 deletions

diff --git a/compiler/prelude/ForeignCall.hs b/compiler/prelude/ForeignCall.hs
deleted file mode 100644
index c143b1ed1e..0000000000
--- a/compiler/prelude/ForeignCall.hs
+++ /dev/null
@@ -1,348 +0,0 @@
-{-
-(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-
-\section[Foreign]{Foreign calls}
--}
-
-{-# LANGUAGE DeriveDataTypeable #-}
-
-module ForeignCall (
-        ForeignCall(..), isSafeForeignCall,
-        Safety(..), playSafe, playInterruptible,
-
-        CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
-        CCallSpec(..),
-        CCallTarget(..), isDynamicTarget,
-        CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute,
-
-        Header(..), CType(..),
-    ) where
-
-import GhcPrelude
-
-import FastString
-import Binary
-import Outputable
-import Module
-import BasicTypes ( SourceText, pprWithSourceText )
-
-import Data.Char
-import Data.Data
-
-{-
-************************************************************************
-*                                                                      *
-\subsubsection{Data types}
-*                                                                      *
-************************************************************************
--}
-
-newtype ForeignCall = CCall CCallSpec
-  deriving Eq
-
-isSafeForeignCall :: ForeignCall -> Bool
-isSafeForeignCall (CCall (CCallSpec _ _ safe)) = playSafe safe
-
--- 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
-
-data Safety
-  = PlaySafe            -- Might invoke Haskell GC, or do a call back, or
-                        -- switch threads, etc.  So make sure things are
-                        -- tidy before the call. Additionally, in the threaded
-                        -- RTS we arrange for the external call to be executed
-                        -- by a separate OS thread, i.e., _concurrently_ to the
-                        -- execution of other Haskell threads.
-
-  | PlayInterruptible   -- Like PlaySafe, but additionally
-                        -- the worker thread running this foreign call may
-                        -- be unceremoniously killed, so it must be scheduled
-                        -- on an unbound thread.
-
-  | PlayRisky           -- None of the above can happen; the call will return
-                        -- without interacting with the runtime system at all
-  deriving ( Eq, Show, Data )
-        -- Show used just for Show Lex.Token, I think
-
-instance Outputable Safety where
-  ppr PlaySafe = text "safe"
-  ppr PlayInterruptible = text "interruptible"
-  ppr PlayRisky = text "unsafe"
-
-playSafe :: Safety -> Bool
-playSafe PlaySafe = True
-playSafe PlayInterruptible = True
-playSafe PlayRisky = False
-
-playInterruptible :: Safety -> Bool
-playInterruptible PlayInterruptible = True
-playInterruptible _ = False
-
-{-
-************************************************************************
-*                                                                      *
-\subsubsection{Calling C}
-*                                                                      *
-************************************************************************
--}
-
-data CExportSpec
-  = CExportStatic               -- foreign export ccall foo :: ty
-        SourceText              -- of the CLabelString.
-                                -- See note [Pragma source text] in BasicTypes
-        CLabelString            -- C Name of exported function
-        CCallConv
-  deriving Data
-
-data CCallSpec
-  =  CCallSpec  CCallTarget     -- What to call
-                CCallConv       -- Calling convention to use.
-                Safety
-  deriving( Eq )
-
--- The call target:
-
--- | How to call a particular function in C-land.
-data CCallTarget
-  -- An "unboxed" ccall# to named function in a particular package.
-  = StaticTarget
-        SourceText                -- of the CLabelString.
-                                  -- See note [Pragma source text] in BasicTypes
-        CLabelString                    -- C-land name of label.
-
-        (Maybe UnitId)              -- What package the function is in.
-                                        -- If Nothing, then it's taken to be in the current package.
-                                        -- Note: This information is only used for PrimCalls on Windows.
-                                        --       See CLabel.labelDynamic and CoreToStg.coreToStgApp
-                                        --       for the difference in representation between PrimCalls
-                                        --       and ForeignCalls. If the CCallTarget is representing
-                                        --       a regular ForeignCall then it's safe to set this to Nothing.
-
-  -- The first argument of the import is the name of a function pointer (an Addr#).
-  --    Used when importing a label as "foreign import ccall "dynamic" ..."
-        Bool                            -- True => really a function
-                                        -- False => a value; only
-                                        -- allowed in CAPI imports
-  | DynamicTarget
-
-  deriving( Eq, Data )
-
-isDynamicTarget :: CCallTarget -> Bool
-isDynamicTarget DynamicTarget = True
-isDynamicTarget _             = False
-
-{-
-Stuff to do with calling convention:
-
-ccall:          Caller allocates parameters, *and* deallocates them.
-
-stdcall:        Caller allocates parameters, callee deallocates.
-                Function name has @N after it, where N is number of arg bytes
-                e.g.  _Foo@8. This convention is x86 (win32) specific.
-
-See: http://www.programmersheaven.com/2/Calling-conventions
--}
-
--- any changes here should be replicated in  the CallConv type in template haskell
-data CCallConv = CCallConv | CApiConv | StdCallConv | PrimCallConv | JavaScriptCallConv
-  deriving (Eq, Data)
-
-instance Outputable CCallConv where
-  ppr StdCallConv = text "stdcall"
-  ppr CCallConv   = text "ccall"
-  ppr CApiConv    = text "capi"
-  ppr PrimCallConv = text "prim"
-  ppr JavaScriptCallConv = text "javascript"
-
-defaultCCallConv :: CCallConv
-defaultCCallConv = CCallConv
-
-ccallConvToInt :: CCallConv -> Int
-ccallConvToInt StdCallConv = 0
-ccallConvToInt CCallConv   = 1
-ccallConvToInt CApiConv    = panic "ccallConvToInt CApiConv"
-ccallConvToInt (PrimCallConv {}) = panic "ccallConvToInt PrimCallConv"
-ccallConvToInt JavaScriptCallConv = panic "ccallConvToInt JavaScriptCallConv"
-
-{-
-Generate the gcc attribute corresponding to the given
-calling convention (used by PprAbsC):
--}
-
-ccallConvAttribute :: CCallConv -> SDoc
-ccallConvAttribute StdCallConv       = text "__attribute__((__stdcall__))"
-ccallConvAttribute CCallConv         = empty
-ccallConvAttribute CApiConv          = empty
-ccallConvAttribute (PrimCallConv {}) = panic "ccallConvAttribute PrimCallConv"
-ccallConvAttribute JavaScriptCallConv = panic "ccallConvAttribute JavaScriptCallConv"
-
-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
-
--- Printing into C files:
-
-instance Outputable CExportSpec where
-  ppr (CExportStatic _ str _) = pprCLabelString str
-
-instance Outputable CCallSpec where
-  ppr (CCallSpec fun cconv safety)
-    = hcat [ whenPprDebug callconv, ppr_fun fun ]
-    where
-      callconv = text "{-" <> ppr cconv <> text "-}"
-
-      gc_suf | playSafe safety = text "_GC"
-             | otherwise       = empty
-
-      ppr_fun (StaticTarget st _fn mPkgId isFun)
-        = text (if isFun then "__pkg_ccall"
-                         else "__pkg_ccall_value")
-       <> gc_suf
-       <+> (case mPkgId of
-            Nothing -> empty
-            Just pkgId -> ppr pkgId)
-       <+> (pprWithSourceText st empty)
-
-      ppr_fun DynamicTarget
-        = text "__dyn_ccall" <> gc_suf <+> text "\"\""
-
--- The filename for a C header file
--- Note [Pragma source text] in BasicTypes
-data Header = Header SourceText FastString
-    deriving (Eq, Data)
-
-instance Outputable Header where
-    ppr (Header st h) = pprWithSourceText st (doubleQuotes $ ppr h)
-
--- | A C type, used in CAPI FFI calls
---
---  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# CTYPE'@,
---        'ApiAnnotation.AnnHeader','ApiAnnotation.AnnVal',
---        'ApiAnnotation.AnnClose' @'\#-}'@,
-
--- For details on above see note [Api annotations] in ApiAnnotation
-data CType = CType SourceText -- Note [Pragma source text] in BasicTypes
-                   (Maybe Header) -- header to include for this type
-                   (SourceText,FastString) -- the type itself
-    deriving (Eq, Data)
-
-instance Outputable CType where
-    ppr (CType stp mh (stct,ct))
-      = pprWithSourceText stp (text "{-# CTYPE") <+> hDoc
-        <+> pprWithSourceText stct (doubleQuotes (ftext ct)) <+> text "#-}"
-        where hDoc = case mh of
-                     Nothing -> empty
-                     Just h -> ppr h
-
-{-
-************************************************************************
-*                                                                      *
-\subsubsection{Misc}
-*                                                                      *
-************************************************************************
--}
-
-instance Binary ForeignCall where
-    put_ bh (CCall aa) = put_ bh aa
-    get bh = do aa <- get bh; return (CCall aa)
-
-instance Binary Safety where
-    put_ bh PlaySafe = do
-            putByte bh 0
-    put_ bh PlayInterruptible = do
-            putByte bh 1
-    put_ bh PlayRisky = do
-            putByte bh 2
-    get bh = do
-            h <- getByte bh
-            case h of
-              0 -> do return PlaySafe
-              1 -> do return PlayInterruptible
-              _ -> do return PlayRisky
-
-instance Binary CExportSpec where
-    put_ bh (CExportStatic ss aa ab) = do
-            put_ bh ss
-            put_ bh aa
-            put_ bh ab
-    get bh = do
-          ss <- get bh
-          aa <- get bh
-          ab <- get bh
-          return (CExportStatic ss 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 ss aa ab ac) = do
-            putByte bh 0
-            put_ bh ss
-            put_ bh aa
-            put_ bh ab
-            put_ bh ac
-    put_ bh DynamicTarget = do
-            putByte bh 1
-    get bh = do
-            h <- getByte bh
-            case h of
-              0 -> do ss <- get bh
-                      aa <- get bh
-                      ab <- get bh
-                      ac <- get bh
-                      return (StaticTarget ss aa ab ac)
-              _ -> do return DynamicTarget
-
-instance Binary CCallConv where
-    put_ bh CCallConv = do
-            putByte bh 0
-    put_ bh StdCallConv = do
-            putByte bh 1
-    put_ bh PrimCallConv = do
-            putByte bh 2
-    put_ bh CApiConv = do
-            putByte bh 3
-    put_ bh JavaScriptCallConv = do
-            putByte bh 4
-    get bh = do
-            h <- getByte bh
-            case h of
-              0 -> do return CCallConv
-              1 -> do return StdCallConv
-              2 -> do return PrimCallConv
-              3 -> do return CApiConv
-              _ -> do return JavaScriptCallConv
-
-instance Binary CType where
-    put_ bh (CType s mh fs) = do put_ bh s
-                                 put_ bh mh
-                                 put_ bh fs
-    get bh = do s  <- get bh
-                mh <- get bh
-                fs <- get bh
-                return (CType s mh fs)
-
-instance Binary Header where
-    put_ bh (Header s h) = put_ bh s >> put_ bh h
-    get bh = do s <- get bh
-                h <- get bh
-                return (Header s h)