{-# LANGUAGE OverloadedStrings #-}
module GHC.StgToJS.Utils
( assignToTypedExprs
, assignCoerce1
, assignToExprCtx
)
where
import GHC.Prelude
import GHC.StgToJS.Types
import GHC.StgToJS.ExprCtx
import GHC.JS.Syntax
import GHC.JS.Make
import GHC.Core.TyCon
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Outputable
assignToTypedExprs :: HasDebugCallStack => [TypedExpr] -> [JExpr] -> JStat
assignToTypedExprs :: (() :: Constraint) => [TypedExpr] -> [JExpr] -> JStat
assignToTypedExprs [TypedExpr]
tes [JExpr]
es =
[JExpr] -> [JExpr] -> JStat
(() :: Constraint) => [JExpr] -> [JExpr] -> JStat
assignAllEqual ((TypedExpr -> [JExpr]) -> [TypedExpr] -> [JExpr]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TypedExpr -> [JExpr]
typex_expr [TypedExpr]
tes) [JExpr]
es
assignTypedExprs :: [TypedExpr] -> [TypedExpr] -> JStat
assignTypedExprs :: [TypedExpr] -> [TypedExpr] -> JStat
assignTypedExprs [TypedExpr]
tes [TypedExpr]
es =
[TypedExpr] -> [JExpr] -> JStat
(() :: Constraint) => [TypedExpr] -> [JExpr] -> JStat
assignToTypedExprs [TypedExpr]
tes ((TypedExpr -> [JExpr]) -> [TypedExpr] -> [JExpr]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TypedExpr -> [JExpr]
typex_expr [TypedExpr]
es)
assignToExprCtx :: HasDebugCallStack => ExprCtx -> [JExpr] -> JStat
assignToExprCtx :: (() :: Constraint) => ExprCtx -> [JExpr] -> JStat
assignToExprCtx ExprCtx
ctx [JExpr]
es = [TypedExpr] -> [JExpr] -> JStat
(() :: Constraint) => [TypedExpr] -> [JExpr] -> JStat
assignToTypedExprs (ExprCtx -> [TypedExpr]
ctxTarget ExprCtx
ctx) [JExpr]
es
assignCoerce1 :: HasDebugCallStack => [TypedExpr] -> [TypedExpr] -> JStat
assignCoerce1 :: (() :: Constraint) => [TypedExpr] -> [TypedExpr] -> JStat
assignCoerce1 [TypedExpr
x] [TypedExpr
y] = TypedExpr -> TypedExpr -> JStat
assignCoerce TypedExpr
x TypedExpr
y
assignCoerce1 [] [] = JStat
forall a. Monoid a => a
mempty
assignCoerce1 [TypedExpr]
x [TypedExpr]
y = String -> SDoc -> JStat
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"assignCoerce1"
([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lengths do not match"
, [TypedExpr] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TypedExpr]
x
, [TypedExpr] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TypedExpr]
y
])
assignCoerce :: TypedExpr -> TypedExpr -> JStat
assignCoerce :: TypedExpr -> TypedExpr -> JStat
assignCoerce (TypedExpr PrimRep
AddrRep [JExpr
a_val, JExpr
a_off]) (TypedExpr PrimRep
UnliftedRep [JExpr
sptr]) = [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat
[ JExpr
a_val JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$stablePtrBuf"
, JExpr
a_off JExpr -> JExpr -> JStat
|= JExpr
sptr
]
assignCoerce (TypedExpr PrimRep
UnliftedRep [JExpr
sptr]) (TypedExpr PrimRep
AddrRep [JExpr
_a_val, JExpr
a_off]) =
JExpr
sptr JExpr -> JExpr -> JStat
|= JExpr
a_off
assignCoerce TypedExpr
p1 TypedExpr
p2 = [TypedExpr] -> [TypedExpr] -> JStat
assignTypedExprs [TypedExpr
p1] [TypedExpr
p2]