{-# LANGUAGE DerivingVia #-}
module GHC.Types.ForeignStubs
   ( ForeignStubs (..)
   , CHeader(..)
   , CStub(..)
   , initializerCStub
   , finalizerCStub
   , appendStubC
   )
where
import {-# SOURCE #-} GHC.Cmm.CLabel
import GHC.Platform
import GHC.Utils.Outputable
import Data.List ((++))
import Data.Monoid
import Data.Semigroup
import Data.Coerce
data CStub = CStub { CStub -> SDoc
getCStub :: SDoc
                   , CStub -> [CLabel]
getInitializers :: [CLabel]
                     
                     
                     
                   , CStub -> [CLabel]
getFinalizers :: [CLabel]
                     
                   }
emptyCStub :: CStub
emptyCStub :: CStub
emptyCStub = SDoc -> [CLabel] -> [CLabel] -> CStub
CStub SDoc
empty [] []
instance Monoid CStub where
  mempty :: CStub
mempty = CStub
emptyCStub
instance Semigroup CStub where
  CStub SDoc
a0 [CLabel]
b0 [CLabel]
c0 <> :: CStub -> CStub -> CStub
<> CStub SDoc
a1 [CLabel]
b1 [CLabel]
c1 =
      SDoc -> [CLabel] -> [CLabel] -> CStub
CStub (SDoc
a0 SDoc -> SDoc -> SDoc
$$ SDoc
a1) ([CLabel]
b0 [CLabel] -> [CLabel] -> [CLabel]
forall a. [a] -> [a] -> [a]
++ [CLabel]
b1) ([CLabel]
c0 [CLabel] -> [CLabel] -> [CLabel]
forall a. [a] -> [a] -> [a]
++ [CLabel]
c1)
functionCStub :: Platform -> CLabel -> SDoc -> SDoc -> CStub
functionCStub :: Platform -> CLabel -> SDoc -> SDoc -> CStub
functionCStub Platform
platform CLabel
clbl SDoc
declarations SDoc
body =
    SDoc -> [CLabel] -> [CLabel] -> CStub
CStub SDoc
body' [] []
  where
    body' :: SDoc
body' = [SDoc] -> SDoc
vcat
        [ SDoc
declarations
        , [SDoc] -> SDoc
hsep [String -> SDoc
text String
"void", Platform -> LabelStyle -> CLabel -> SDoc
pprCLabel Platform
platform LabelStyle
CStyle CLabel
clbl, String -> SDoc
text String
"(void)"]
        , SDoc -> SDoc
braces SDoc
body
        ]
initializerCStub :: Platform -> CLabel -> SDoc -> SDoc -> CStub
initializerCStub :: Platform -> CLabel -> SDoc -> SDoc -> CStub
initializerCStub Platform
platform CLabel
clbl SDoc
declarations SDoc
body =
    Platform -> CLabel -> SDoc -> SDoc -> CStub
functionCStub Platform
platform CLabel
clbl SDoc
declarations SDoc
body
    CStub -> CStub -> CStub
forall a. Monoid a => a -> a -> a
`mappend` SDoc -> [CLabel] -> [CLabel] -> CStub
CStub SDoc
empty [CLabel
clbl] []
finalizerCStub :: Platform -> CLabel -> SDoc -> SDoc -> CStub
finalizerCStub :: Platform -> CLabel -> SDoc -> SDoc -> CStub
finalizerCStub Platform
platform CLabel
clbl SDoc
declarations SDoc
body =
    Platform -> CLabel -> SDoc -> SDoc -> CStub
functionCStub Platform
platform CLabel
clbl SDoc
declarations SDoc
body
    CStub -> CStub -> CStub
forall a. Monoid a => a -> a -> a
`mappend` SDoc -> [CLabel] -> [CLabel] -> CStub
CStub SDoc
empty [] [CLabel
clbl]
newtype  =  {  :: SDoc }
instance Monoid CHeader where
  mempty :: CHeader
mempty = SDoc -> CHeader
CHeader SDoc
empty
  mconcat :: [CHeader] -> CHeader
mconcat = ([SDoc] -> SDoc) -> [CHeader] -> CHeader
forall a b. Coercible a b => a -> b
coerce [SDoc] -> SDoc
vcat
instance Semigroup CHeader where
    <> :: CHeader -> CHeader -> CHeader
(<>) = (SDoc -> SDoc -> SDoc) -> CHeader -> CHeader -> CHeader
forall a b. Coercible a b => a -> b
coerce SDoc -> SDoc -> SDoc
($$)
data ForeignStubs
  = NoStubs
      
  | ForeignStubs CHeader CStub
      
      
      
      
      
      
      
appendStubC :: ForeignStubs -> CStub -> ForeignStubs
appendStubC :: ForeignStubs -> CStub -> ForeignStubs
appendStubC ForeignStubs
NoStubs         CStub
c_code = CHeader -> CStub -> ForeignStubs
ForeignStubs CHeader
forall a. Monoid a => a
mempty CStub
c_code
appendStubC (ForeignStubs CHeader
h CStub
c) CStub
c_code = CHeader -> CStub -> ForeignStubs
ForeignStubs CHeader
h (CStub
c CStub -> CStub -> CStub
forall a. Monoid a => a -> a -> a
`mappend` CStub
c_code)