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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
{-# LANGUAGE CPP,
FlexibleInstances,
OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.StgToJS.Rts.Apply
-- Copyright : (c) The University of Glasgow 2001
-- License : BSD-style (see the file LICENSE)
--
-- Maintainer : Jeffrey Young <jeffrey.young@iohk.io>
-- Luite Stegeman <luite.stegeman@iohk.io>
-- Sylvain Henry <sylvain.henry@iohk.io>
-- Josh Meredith <josh.meredith@iohk.io>
-- Stability : experimental
--
-- Types and utility functions used in the JS RTS.
-----------------------------------------------------------------------------
module GHC.StgToJS.Rts.Types where
import GHC.Prelude
import GHC.JS.Make
import GHC.JS.Syntax
import GHC.StgToJS.Regs
import GHC.StgToJS.Types
--------------------------------------------------------------------------------
-- Syntactic Sugar for some Utilities we want in JS land
--------------------------------------------------------------------------------
-- | Syntactic sugar, i.e., a Haskell function which generates useful JS code.
-- Given a @JExpr@, 'ex', inject a trace statement on 'ex' in the compiled JS
-- program
traceRts :: StgToJSConfig -> JExpr -> JStat
traceRts s ex | (csTraceRts s) = appS "h$log" [ex]
| otherwise = mempty
-- | Syntactic sugar. Given a @JExpr@, 'ex' which is assumed to be a predicate,
-- and a message 'm', assert that 'not ex' is True, if not throw an exception in
-- JS land with message 'm'.
assertRts :: ToJExpr a => StgToJSConfig -> JExpr -> a -> JStat
assertRts s ex m | csAssertRts s = jwhenS (UOpExpr NotOp ex) (appS "throw" [toJExpr m])
| otherwise = mempty
-- | name of the closure 'c'
clName :: JExpr -> JExpr
clName c = c .^ "n"
-- | Type name of the closure 'c'
clTypeName :: JExpr -> JExpr
clTypeName c = app "h$closureTypeName" [c .^ "t"]
-- number of arguments (arity & 0xff = arguments, arity >> 8 = number of registers)
stackFrameSize :: JExpr -- ^ assign frame size to this
-> JExpr -- ^ stack frame header function
-> JStat -- ^ size of the frame, including header
stackFrameSize tgt f =
ifS (f .===. var "h$ap_gen") -- h$ap_gen is special
(tgt |= (stack .! (sp - 1) .>>. 8) + 2)
(jVar (\tag ->
mconcat
[tag |= f .^ "size"
, ifS (tag .<. 0) -- if tag is less than 0
(tgt |= stack .! (sp - 1)) -- set target to stack pointer - 1
(tgt |= mask8 tag + 1) -- else set to mask'd tag + 1
]
))
--------------------------------------------------------------------------------
-- Register utilities
--------------------------------------------------------------------------------
-- | Perform the computation 'f', on the range of registers bounded by 'start'
-- and 'end'.
withRegs :: StgReg -> StgReg -> (StgReg -> JStat) -> JStat
withRegs start end f = mconcat $ fmap f [start..end]
|
