    {-# LANGUAGE MultiWayIf #-}
    {-# LANGUAGE TupleSections #-}
    {-# LANGUAGE OverloadedStrings #-}

    module GHC.StgToJS.FFI
      ( genPrimCall
      , genForeignCall
      )
    where

    import GHC.Prelude

    import GHC.JS.JStg.Syntax
    import GHC.JS.Ident
    import GHC.JS.Make

    import GHC.StgToJS.Arg
    import GHC.StgToJS.ExprCtx
    import GHC.StgToJS.Monad
    import GHC.StgToJS.Types
    import GHC.StgToJS.Literal
    import GHC.StgToJS.Regs
    import GHC.StgToJS.Utils
    import GHC.StgToJS.Ids

    import GHC.Types.RepType
    import GHC.Types.ForeignCall
    import GHC.Types.Unique.Map

    import GHC.Stg.Syntax

    import GHC.Builtin.PrimOps
    import GHC.Builtin.Types.Prim

    import GHC.Core.Type hiding (typeSize)

    import GHC.Utils.Misc
    import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr)
    import GHC.Data.FastString

    import Data.Char
    import Data.Monoid
    import qualified Data.List as L

    genPrimCall :: ExprCtx -> PrimCall -> [StgArg] -> Type -> G (JStgStat, ExprResult)
    genPrimCall :: ExprCtx -> PrimCall -> [StgArg] -> Type -> G (JStgStat, ExprResult)
    genPrimCall ExprCtx
    ctx (PrimCall FastString
    lbl Unit
    _) [StgArg]
    args Type
    t = do
      j <- Bool
    -> Bool
    -> Bool
    -> String
    -> Type
    -> [JStgExpr]
    -> [StgArg]
    -> G JStgStat
    parseFFIPattern Bool
    False Bool
    False Bool
    False (String
    "h$" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ FastString -> String
    unpackFS FastString
    lbl) Type
    t ((TypedExpr -> [JStgExpr]) -> [TypedExpr] -> [JStgExpr]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap TypedExpr -> [JStgExpr]
    typex_expr ([TypedExpr] -> [JStgExpr]) -> [TypedExpr] -> [JStgExpr]
    forall a b. (a -> b) -> a -> b
    $ ExprCtx -> [TypedExpr]
    ctxTarget ExprCtx
    ctx) [StgArg]
    args
      return (j, ExprInline)

    -- | generate the actual call
    {-
      parse FFI patterns:
       "&value         -> value
      1. "function"      -> ret = function(...)
      2. "$r = $1.f($2)  -> r1 = a1.f(a2)

      arguments, $1, $2, $3 unary arguments
         $1_1, $1_2, for a binary argument

      return type examples
      1. $r                      unary return
      2. $r1, $r2                binary return
      3. $r1, $r2, $r3_1, $r3_2  unboxed tuple return
     -}
    parseFFIPattern :: Bool  -- ^ catch exception and convert them to haskell exceptions
                    -> Bool  -- ^ async (only valid with javascript calling conv)
                    -> Bool  -- ^ using javascript calling convention
                    -> String
                    -> Type
                    -> [JStgExpr]
                    -> [StgArg]
                    -> G JStgStat
    parseFFIPattern :: Bool
    -> Bool
    -> Bool
    -> String
    -> Type
    -> [JStgExpr]
    -> [StgArg]
    -> G JStgStat
    parseFFIPattern Bool
    catchExcep Bool
    async Bool
    jscc String
    pat Type
    t [JStgExpr]
    es [StgArg]
    as
      | Bool
    catchExcep = do
          c <- Bool
    -> Bool -> String -> Type -> [JStgExpr] -> [StgArg] -> G JStgStat
    parseFFIPatternA Bool
    async Bool
    jscc String
    pat Type
    t [JStgExpr]
    es [StgArg]
    as
          -- Generate:
          --  try {
          --    `c`;
          --  } catch(except) {
          --    return h$throwJSException(except);
          --  }
          let ex = FastString -> Ident
    global FastString
    "except"
          return (TryStat c ex (ReturnStat (ApplExpr (var "h$throwJSException") [toJExpr ex])) mempty)
      | Bool
    otherwise  = Bool
    -> Bool -> String -> Type -> [JStgExpr] -> [StgArg] -> G JStgStat
    parseFFIPatternA Bool
    async Bool
    jscc String
    pat Type
    t [JStgExpr]
    es [StgArg]
    as

    parseFFIPatternA :: Bool  -- ^ async
                     -> Bool  -- ^ using JavaScript calling conv
                     -> String
                     -> Type
                     -> [JStgExpr]
                     -> [StgArg]
                     -> G JStgStat
    -- async calls get an extra callback argument
    -- call it with the result
    parseFFIPatternA :: Bool
    -> Bool -> String -> Type -> [JStgExpr] -> [StgArg] -> G JStgStat
    parseFFIPatternA Bool
    True Bool
    True String
    pat Type
    t [JStgExpr]
    es [StgArg]
    as  = do
      cb <- G Ident
    freshIdent
      x  <- freshIdent
      d  <- freshIdent
      stat <- parseFFIPattern' (Just (toJExpr cb)) True pat t es as
      return $ mconcat
        [ x  ||= (toJExpr (jhFromList [("mv", null_)]))
        , cb ||= ApplExpr (var "h$mkForeignCallback") [toJExpr x]
        , stat
        , IfStat (InfixExpr StrictEqOp (toJExpr x .^ "mv") null_)
              (mconcat
                [ toJExpr x .^ "mv" |= UOpExpr NewOp (ApplExpr (var "h$MVar") [])
                , sp |= Add sp one_
                , (IdxExpr stack sp) |= var "h$unboxFFIResult"
                , ReturnStat $ ApplExpr (var "h$takeMVar") [toJExpr x .^ "mv"]
                ])
              (mconcat
                [ d ||= toJExpr x .^ "mv"
                , copyResult (toJExpr d)
                ])
        ]
        where nrst :: Int
    nrst = Type -> Int
    typeSize Type
    t
              copyResult :: JStgExpr -> JStgStat
    copyResult JStgExpr
    d = [JStgExpr] -> [JStgExpr] -> JStgStat
    HasDebugCallStack => [JStgExpr] -> [JStgExpr] -> JStgStat
    assignAllEqual [JStgExpr]
    es ((Int -> JStgExpr) -> [Int] -> [JStgExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map (JStgExpr -> JStgExpr -> JStgExpr
    IdxExpr JStgExpr
    d (JStgExpr -> JStgExpr) -> (Int -> JStgExpr) -> Int -> JStgExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr) [Int
    0..Int
    nrstInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1])
    parseFFIPatternA Bool
    _async Bool
    javascriptCc String
    pat Type
    t [JStgExpr]
    es [StgArg]
    as =
      Maybe JStgExpr
    -> Bool -> String -> Type -> [JStgExpr] -> [StgArg] -> G JStgStat
    parseFFIPattern' Maybe JStgExpr
    forall a. Maybe a
    Nothing Bool
    javascriptCc String
    pat Type
    t [JStgExpr]
    es [StgArg]
    as

    -- parseFFIPatternA _ _ _ _ _ _ = error "parseFFIPattern: non-JavaScript pattern must be synchronous"

    parseFFIPattern' :: Maybe JStgExpr -- ^ Nothing for sync, Just callback for async
                     -> Bool           -- ^ javascript calling convention used
                     -> String         -- ^ pattern called
                     -> Type           -- ^ return type
                     -> [JStgExpr]     -- ^ expressions to return in (may be more than necessary)
                     -> [StgArg]       -- ^ arguments
                     -> G JStgStat
    parseFFIPattern' :: Maybe JStgExpr
    -> Bool -> String -> Type -> [JStgExpr] -> [StgArg] -> G JStgStat
    parseFFIPattern' Maybe JStgExpr
    callback Bool
    javascriptCc String
    pat Type
    t [JStgExpr]
    ret [StgArg]
    args
      | Bool -> Bool
    not Bool
    javascriptCc = String -> G JStgStat
    mkApply String
    pat
      | Bool
    otherwise = String -> G JStgStat
    mkApply String
    pat
      where
        tgt :: [JStgExpr]
    tgt = Int -> [JStgExpr] -> [JStgExpr]
    forall a. Int -> [a] -> [a]
    take (Type -> Int
    typeSize Type
    t) [JStgExpr]
    ret
        -- automatic apply, build call and result copy
        mkApply :: String -> G JStgStat
    mkApply String
    f
          | Just JStgExpr
    cb <- Maybe JStgExpr
    callback = do
             (stats, as) <- [(JStgStat, [JStgExpr])] -> ([JStgStat], [[JStgExpr]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(JStgStat, [JStgExpr])] -> ([JStgStat], [[JStgExpr]]))
    -> StateT GenState IO [(JStgStat, [JStgExpr])]
    -> StateT GenState IO ([JStgStat], [[JStgExpr]])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (StgArg -> StateT GenState IO (JStgStat, [JStgExpr]))
    -> [StgArg] -> StateT GenState IO [(JStgStat, [JStgExpr])]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Bool -> StgArg -> StateT GenState IO (JStgStat, [JStgExpr])
    genFFIArg Bool
    javascriptCc) [StgArg]
    args
             cs <- getSettings
             return $ traceCall cs as <> mconcat stats <> ApplStat f' (concat as++[cb])
          | {-ts@-}
            (JStgExpr
    t:[JStgExpr]
    ts') <- [JStgExpr]
    tgt = do
             (stats, as) <- [(JStgStat, [JStgExpr])] -> ([JStgStat], [[JStgExpr]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(JStgStat, [JStgExpr])] -> ([JStgStat], [[JStgExpr]]))
    -> StateT GenState IO [(JStgStat, [JStgExpr])]
    -> StateT GenState IO ([JStgStat], [[JStgExpr]])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (StgArg -> StateT GenState IO (JStgStat, [JStgExpr]))
    -> [StgArg] -> StateT GenState IO [(JStgStat, [JStgExpr])]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Bool -> StgArg -> StateT GenState IO (JStgStat, [JStgExpr])
    genFFIArg Bool
    javascriptCc) [StgArg]
    args
             cs <- getSettings
             return $ traceCall cs as
                    <> mconcat stats
                    <> (t |= ApplExpr f' (concat as) )
                    <> copyResult ts'
               -- _ -> error "mkApply: empty list"
          | Bool
    otherwise = do
             (stats, as) <- [(JStgStat, [JStgExpr])] -> ([JStgStat], [[JStgExpr]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(JStgStat, [JStgExpr])] -> ([JStgStat], [[JStgExpr]]))
    -> StateT GenState IO [(JStgStat, [JStgExpr])]
    -> StateT GenState IO ([JStgStat], [[JStgExpr]])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (StgArg -> StateT GenState IO (JStgStat, [JStgExpr]))
    -> [StgArg] -> StateT GenState IO [(JStgStat, [JStgExpr])]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Bool -> StgArg -> StateT GenState IO (JStgStat, [JStgExpr])
    genFFIArg Bool
    javascriptCc) [StgArg]
    args
             cs <- getSettings
             return $ traceCall cs as <> mconcat stats <> ApplStat f' (concat as)
            where f' :: JStgExpr
    f' = Ident -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (FastString -> Ident
    global (FastString -> Ident) -> FastString -> Ident
    forall a b. (a -> b) -> a -> b
    $ String -> FastString
    mkFastString String
    f)
        copyResult :: [a] -> JStgStat
    copyResult [a]
    rs = [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
    forall a b. (a -> b) -> a -> b
    $ (StgRet -> a -> JStgStat) -> [StgRet] -> [a] -> [JStgStat]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\StgRet
    t a
    r -> a -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr a
    r JStgExpr -> JStgExpr -> JStgStat
    |= StgRet -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr StgRet
    t) (StgRet -> [StgRet]
    forall a. Enum a => a -> [a]
    enumFrom StgRet
    Ret1) [a]
    rs

        traceCall :: StgToJSConfig -> [[JStgExpr]] -> JStgStat
    traceCall StgToJSConfig
    cs [[JStgExpr]]
    as
            | StgToJSConfig -> Bool
    csTraceForeign StgToJSConfig
    cs = JStgExpr -> [JStgExpr] -> JStgStat
    ApplStat (FastString -> JStgExpr
    var FastString
    "h$traceForeign") [String -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr String
    pat, [[JStgExpr]] -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr [[JStgExpr]]
    as]
            | Bool
    otherwise         = JStgStat
    forall a. Monoid a => a
    mempty

    -- generate arg to be passed to FFI call, with marshalling JStgStat to be run
    -- before the call
    genFFIArg :: Bool -> StgArg -> G (JStgStat, [JStgExpr])
    genFFIArg :: Bool -> StgArg -> StateT GenState IO (JStgStat, [JStgExpr])
    genFFIArg Bool
    _isJavaScriptCc (StgLitArg Literal
    l) = (JStgStat
    forall a. Monoid a => a
    mempty,) ([JStgExpr] -> (JStgStat, [JStgExpr]))
    -> StateT GenState IO [JStgExpr]
    -> StateT GenState IO (JStgStat, [JStgExpr])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HasDebugCallStack => Literal -> StateT GenState IO [JStgExpr]
    Literal -> StateT GenState IO [JStgExpr]
    genLit Literal
    l
    genFFIArg Bool
    isJavaScriptCc a :: StgArg
    a@(StgVarArg Id
    i)
        | Bool -> Bool
    not Bool
    isJavaScriptCc Bool -> Bool -> Bool
    &&
          (TyCon
    tycon TyCon -> TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon
    byteArrayPrimTyCon Bool -> Bool -> Bool
    || TyCon
    tycon TyCon -> TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon
    mutableByteArrayPrimTyCon) =
            (\JStgExpr
    x -> (JStgStat
    forall a. Monoid a => a
    mempty,[JStgExpr
    x, JStgExpr
    zero_])) (JStgExpr -> (JStgStat, [JStgExpr]))
    -> StateT GenState IO JStgExpr
    -> StateT GenState IO (JStgStat, [JStgExpr])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Id -> StateT GenState IO JStgExpr
    varForId Id
    i
        | JSRep -> Bool
    isVoid JSRep
    r                  = (JStgStat, [JStgExpr]) -> StateT GenState IO (JStgStat, [JStgExpr])
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat
    forall a. Monoid a => a
    mempty, [])
    --    | Just x <- marshalFFIArg a = x
        | JSRep -> Bool
    isMultiVar JSRep
    r              = (JStgStat
    forall a. Monoid a => a
    mempty,) ([JStgExpr] -> (JStgStat, [JStgExpr]))
    -> StateT GenState IO [JStgExpr]
    -> StateT GenState IO (JStgStat, [JStgExpr])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Int -> StateT GenState IO JStgExpr)
    -> [Int] -> StateT GenState IO [JStgExpr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Id -> Int -> StateT GenState IO JStgExpr
    varForIdN Id
    i) [Int
    1..JSRep -> Int
    varSize JSRep
    r]
        | Bool
    otherwise                 = (\JStgExpr
    x -> (JStgStat
    forall a. Monoid a => a
    mempty,[JStgExpr
    x])) (JStgExpr -> (JStgStat, [JStgExpr]))
    -> StateT GenState IO JStgExpr
    -> StateT GenState IO (JStgStat, [JStgExpr])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Id -> StateT GenState IO JStgExpr
    varForId Id
    i
       where
         tycon :: TyCon
    tycon  = HasDebugCallStack => Type -> TyCon
    Type -> TyCon
    tyConAppTyCon (Type -> Type
    unwrapType Type
    arg_ty)
         arg_ty :: Type
    arg_ty = StgArg -> Type
    stgArgType StgArg
    a
         r :: JSRep
    r      = HasDebugCallStack => Type -> JSRep
    Type -> JSRep
    unaryTypeJSRep Type
    arg_ty

    genForeignCall :: HasDebugCallStack
                   => ExprCtx
                   -> ForeignCall
                   -> Type
                   -> [JStgExpr]
                   -> [StgArg]
                   -> G (JStgStat, ExprResult)
    genForeignCall :: HasDebugCallStack =>
    ExprCtx
    -> ForeignCall
    -> Type
    -> [JStgExpr]
    -> [StgArg]
    -> G (JStgStat, ExprResult)
    genForeignCall ExprCtx
    _ctx
                   (CCall (CCallSpec (StaticTarget SourceText
    _ FastString
    tgt Maybe Unit
    Nothing Bool
    True)
                                       CCallConv
    JavaScriptCallConv
                                       Safety
    PlayRisky))
                   Type
    _t
                   [JStgExpr
    obj]
                   [StgArg]
    args
      | FastString
    tgt FastString -> FastString -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> FastString
    fsLit String
    "h$buildObject"
      , Just [(FastString, StgArg)]
    pairs <- [StgArg] -> Maybe [(FastString, StgArg)]
    getObjectKeyValuePairs [StgArg]
    args = do
          pairs' <- ((FastString, StgArg) -> StateT GenState IO (FastString, JStgExpr))
    -> [(FastString, StgArg)]
    -> StateT GenState IO [(FastString, JStgExpr)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (\(FastString
    k,StgArg
    v) -> HasDebugCallStack => StgArg -> StateT GenState IO [JStgExpr]
    StgArg -> StateT GenState IO [JStgExpr]
    genArg StgArg
    v StateT GenState IO [JStgExpr]
    -> ([JStgExpr] -> StateT GenState IO (FastString, JStgExpr))
    -> StateT GenState IO (FastString, JStgExpr)
    forall a b.
    StateT GenState IO a
    -> (a -> StateT GenState IO b) -> StateT GenState IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \[JStgExpr]
    vs -> (FastString, JStgExpr) -> StateT GenState IO (FastString, JStgExpr)
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FastString
    k, [JStgExpr] -> JStgExpr
    forall a. HasCallStack => [a] -> a
    head [JStgExpr]
    vs)) [(FastString, StgArg)]
    pairs
          return ( (|=) obj (ValExpr (JHash $ listToUniqMap pairs'))
                 , ExprInline
                 )

    genForeignCall ExprCtx
    ctx (CCall (CCallSpec CCallTarget
    ccTarget CCallConv
    cconv Safety
    safety)) Type
    t [JStgExpr]
    tgt [StgArg]
    args = do
      Maybe RealSrcSpan
    -> FastString
    -> Safety
    -> CCallConv
    -> [FastString]
    -> FastString
    -> G ()
    emitForeign (ExprCtx -> Maybe RealSrcSpan
    ctxSrcSpan ExprCtx
    ctx) (String -> FastString
    mkFastString String
    lbl) Safety
    safety CCallConv
    cconv ((StgArg -> FastString) -> [StgArg] -> [FastString]
    forall a b. (a -> b) -> [a] -> [b]
    map StgArg -> FastString
    showArgType [StgArg]
    args) (Type -> FastString
    showType Type
    t)
      (,ExprResult
    exprResult) (JStgStat -> (JStgStat, ExprResult))
    -> G JStgStat -> G (JStgStat, ExprResult)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Bool
    -> Bool
    -> Bool
    -> String
    -> Type
    -> [JStgExpr]
    -> [StgArg]
    -> G JStgStat
    parseFFIPattern Bool
    catchExcep Bool
    async Bool
    isJsCc String
    lbl Type
    t [JStgExpr]
    tgt' [StgArg]
    args
      where
        isJsCc :: Bool
    isJsCc = CCallConv
    cconv CCallConv -> CCallConv -> Bool
    forall a. Eq a => a -> a -> Bool
    == CCallConv
    JavaScriptCallConv

        lbl :: String
    lbl | (StaticTarget SourceText
    _ FastString
    clbl Maybe Unit
    _mpkg Bool
    _isFunPtr) <- CCallTarget
    ccTarget
                = let clbl' :: String
    clbl' = FastString -> String
    unpackFS FastString
    clbl
                  in  if | Bool
    isJsCc -> String
    clbl'
                         | String
    wrapperPrefix String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `L.isPrefixOf` String
    clbl' ->
                             (String
    "h$" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    2 (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isDigit (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    wrapperPrefix) String
    clbl'))
                         | Bool
    otherwise -> String
    "h$" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    clbl'
            | Bool
    otherwise = String
    "h$callDynamic"

        exprResult :: ExprResult
    exprResult | Bool
    async     = ExprResult
    ExprCont
                   | Bool
    otherwise = ExprResult
    ExprInline

        catchExcep :: Bool
    catchExcep = (CCallConv
    cconv CCallConv -> CCallConv -> Bool
    forall a. Eq a => a -> a -> Bool
    == CCallConv
    JavaScriptCallConv) Bool -> Bool -> Bool
    &&
                     Safety -> Bool
    playSafe Safety
    safety Bool -> Bool -> Bool
    || Safety -> Bool
    playInterruptible Safety
    safety

        async :: Bool
    async | Bool
    isJsCc    = Safety -> Bool
    playInterruptible Safety
    safety
              | Bool
    otherwise = Safety -> Bool
    playInterruptible Safety
    safety Bool -> Bool -> Bool
    || Safety -> Bool
    playSafe Safety
    safety

        tgt' :: [JStgExpr]
    tgt'  | Bool
    async     = Int -> [JStgExpr] -> [JStgExpr]
    forall a. Int -> [a] -> [a]
    take ([JStgExpr] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [JStgExpr]
    tgt) [JStgExpr]
    jsRegsFromR1
              | Bool
    otherwise = [JStgExpr]
    tgt

        wrapperPrefix :: String
    wrapperPrefix = String
    "ghczuwrapperZC"

    getObjectKeyValuePairs :: [StgArg] -> Maybe [(FastString, StgArg)]
    getObjectKeyValuePairs :: [StgArg] -> Maybe [(FastString, StgArg)]
    getObjectKeyValuePairs [] = [(FastString, StgArg)] -> Maybe [(FastString, StgArg)]
    forall a. a -> Maybe a
    Just []
    getObjectKeyValuePairs (StgArg
    k:StgArg
    v:[StgArg]
    xs)
      | Just FastString
    t <- StgArg -> Maybe FastString
    argJSStringLitUnfolding StgArg
    k =
          ([(FastString, StgArg)] -> [(FastString, StgArg)])
    -> Maybe [(FastString, StgArg)] -> Maybe [(FastString, StgArg)]
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((FastString
    t,StgArg
    v)(FastString, StgArg)
    -> [(FastString, StgArg)] -> [(FastString, StgArg)]
    forall a. a -> [a] -> [a]
    :) ([StgArg] -> Maybe [(FastString, StgArg)]
    getObjectKeyValuePairs [StgArg]
    xs)
    getObjectKeyValuePairs [StgArg]
    _ = Maybe [(FastString, StgArg)]
    forall a. Maybe a
    Nothing

    argJSStringLitUnfolding :: StgArg -> Maybe FastString
    argJSStringLitUnfolding :: StgArg -> Maybe FastString
    argJSStringLitUnfolding (StgVarArg Id
    _v) = Maybe FastString
    forall a. Maybe a
    Nothing -- fixme
    argJSStringLitUnfolding StgArg
    _              = Maybe FastString
    forall a. Maybe a
    Nothing

    showArgType :: StgArg -> FastString
    showArgType :: StgArg -> FastString
    showArgType StgArg
    a = Type -> FastString
    showType (StgArg -> Type
    stgArgType StgArg
    a)

    showType :: Type -> FastString
    showType :: Type -> FastString
    showType Type
    t
      | Just TyCon
    tc <- Type -> Maybe TyCon
    tyConAppTyCon_maybe (Type -> Type
    unwrapType Type
    t) =
          String -> FastString
    mkFastString (SDocContext -> SDoc -> String
    renderWithContext SDocContext
    defaultSDocContext (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc))
      | Bool
    otherwise = FastString
    "<unknown>"