{-# 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 =
  -- TODO: check primRep (typex_typ) here?
  [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

-- | Assign first expr only (if it exists), performing coercions between some
-- PrimReps (e.g. StablePtr# and Addr#).
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
                                ])

-- | Assign p2 to p1 with optional coercion
assignCoerce :: TypedExpr -> TypedExpr -> JStat
-- Coercion between StablePtr# and Addr#
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]