blob: 8d16f39a642818c2854b8f0aacc8725b788ff35f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
{-# 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 tes es =
assignAllEqual (concatMap typex_expr tes) es
assignTypedExprs :: [TypedExpr] -> [TypedExpr] -> JStat
assignTypedExprs tes es =
-- TODO: check primRep (typex_typ) here?
assignToTypedExprs tes (concatMap typex_expr es)
assignToExprCtx :: HasDebugCallStack => ExprCtx -> [JExpr] -> JStat
assignToExprCtx ctx es = assignToTypedExprs (ctxTarget ctx) es
-- | Assign first expr only (if it exists), performing coercions between some
-- PrimReps (e.g. StablePtr# and Addr#).
assignCoerce1 :: HasDebugCallStack => [TypedExpr] -> [TypedExpr] -> JStat
assignCoerce1 [x] [y] = assignCoerce x y
assignCoerce1 [] [] = mempty
assignCoerce1 x y = pprPanic "assignCoerce1"
(vcat [ text "lengths do not match"
, ppr x
, ppr y
])
-- | Assign p2 to p1 with optional coercion
assignCoerce :: TypedExpr -> TypedExpr -> JStat
-- Coercion between StablePtr# and Addr#
assignCoerce (TypedExpr AddrRep [a_val, a_off]) (TypedExpr UnliftedRep [sptr]) = mconcat
[ a_val |= var "h$stablePtrBuf"
, a_off |= sptr
]
assignCoerce (TypedExpr UnliftedRep [sptr]) (TypedExpr AddrRep [_a_val, a_off]) =
sptr |= a_off
assignCoerce p1 p2 = assignTypedExprs [p1] [p2]
|
