{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module GHC.StgToJS.Closure
  ( closureInfoStat
  , closure
  , conClosure
  , Closure (..)
  , newClosure
  , assignClosure
  , CopyCC (..)
  , copyClosure
  , mkClosure
  -- $names
  , allocData
  , allocClsA
  , dataName
  , clsName
  , dataFieldName
  , varName
  , jsClosureCount
  )
where

import GHC.Prelude
import GHC.Data.FastString

import GHC.StgToJS.Heap
import GHC.StgToJS.Types
import GHC.StgToJS.Utils
import GHC.StgToJS.Regs (stack,sp)

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

import GHC.Types.Unique.Map

import Data.Array
import Data.Monoid
import qualified Data.Bits as Bits

closureInfoStat :: Bool -> ClosureInfo -> JStgStat
closureInfoStat :: Bool -> ClosureInfo -> JStgStat
closureInfoStat Bool
debug (ClosureInfo Ident
obj CIRegs
rs FastString
name CILayout
layout CIType
ctype CIStatic
srefs)
  = Bool
-> Ident
-> CIRegs
-> CILayout
-> ClosureType
-> FastString
-> Int
-> CIStatic
-> JStgStat
setObjInfoL Bool
debug Ident
obj CIRegs
rs CILayout
layout ClosureType
ty FastString
name Int
tag CIStatic
srefs
      where
        !ty :: ClosureType
ty = case CIType
ctype of
          CIType
CIThunk      -> ClosureType
Thunk
          CIFun {}     -> ClosureType
Fun
          CICon {}     -> ClosureType
Con
          CIType
CIBlackhole  -> ClosureType
Blackhole
          CIType
CIPap        -> ClosureType
Pap
          CIType
CIStackFrame -> ClosureType
StackFrame
        !tag :: Int
tag = case CIType
ctype of
          CIType
CIThunk           -> Int
0
          CIFun Int
arity Int
nregs -> Int -> Int -> Int
mkArityTag Int
arity Int
nregs
          CICon Int
con         -> Int
con
          CIType
CIBlackhole       -> Int
0
          CIType
CIPap             -> Int
0
          CIType
CIStackFrame      -> Int
0


setObjInfoL :: Bool        -- ^ debug: output symbol names
            -> Ident       -- ^ the object name
            -> CIRegs      -- ^ things in registers
            -> CILayout    -- ^ layout of the object
            -> ClosureType -- ^ closure type
            -> FastString  -- ^ object name, for printing
            -> Int         -- ^ `a' argument, depends on type (arity, conid)
            -> CIStatic    -- ^ static refs
            -> JStgStat
setObjInfoL :: Bool
-> Ident
-> CIRegs
-> CILayout
-> ClosureType
-> FastString
-> Int
-> CIStatic
-> JStgStat
setObjInfoL Bool
debug Ident
obj CIRegs
rs CILayout
layout ClosureType
t FastString
n Int
a
  = Bool
-> Ident
-> ClosureType
-> FastString
-> [Int]
-> Int
-> Int
-> CIRegs
-> CIStatic
-> JStgStat
setObjInfo Bool
debug Ident
obj ClosureType
t FastString
n [Int]
field_types Int
a Int
size CIRegs
rs
      where
        size :: Int
size = case CILayout
layout of
          CILayout
CILayoutVariable   -> (-Int
1)
          CILayoutUnknown Int
sz -> Int
sz
          CILayoutFixed Int
sz [JSRep]
_ -> Int
sz
        field_types :: [Int]
field_types = case CILayout
layout of
          CILayout
CILayoutVariable     -> []
          CILayoutUnknown Int
size -> [JSRep] -> [Int]
to_type_list (Int -> JSRep -> [JSRep]
forall a. Int -> a -> [a]
replicate Int
size JSRep
ObjV)
          CILayoutFixed Int
_ [JSRep]
fs   -> [JSRep] -> [Int]
to_type_list [JSRep]
fs
        to_type_list :: [JSRep] -> [Int]
to_type_list = (JSRep -> [Int]) -> [JSRep] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\JSRep
x -> Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (JSRep -> Int
varSize JSRep
x) (JSRep -> Int
forall a. Enum a => a -> Int
fromEnum JSRep
x))

setObjInfo :: Bool        -- ^ debug: output all symbol names
           -> Ident       -- ^ the thing to modify
           -> ClosureType -- ^ closure type
           -> FastString  -- ^ object name, for printing
           -> [Int]       -- ^ list of item types in the object, if known (free variables, datacon fields)
           -> Int         -- ^ extra 'a' parameter, for constructor tag or arity
           -> Int         -- ^ object size, -1 (number of vars) for unknown
           -> CIRegs      -- ^ things in registers
           -> CIStatic    -- ^ static refs
           -> JStgStat
setObjInfo :: Bool
-> Ident
-> ClosureType
-> FastString
-> [Int]
-> Int
-> Int
-> CIRegs
-> CIStatic
-> JStgStat
setObjInfo Bool
debug Ident
obj ClosureType
t FastString
name [Int]
fields Int
a Int
size CIRegs
regs CIStatic
static
   | Bool
debug     = FastString -> [JStgExpr] -> JStgStat
appS FastString
"h$setObjInfo" [ Ident -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr Ident
obj
                                     , ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
t
                                     , FastString -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr FastString
name
                                     , [Int] -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr [Int]
fields
                                     , Int -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr Int
a
                                     , Int -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr Int
size
                                     , Int -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (CIRegs -> Int
regTag CIRegs
regs)
                                     , CIStatic -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr CIStatic
static
                                     ]
   | Bool
otherwise = FastString -> [JStgExpr] -> JStgStat
appS FastString
"h$o" [ Ident -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr Ident
obj
                            , ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
t
                            , Int -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr Int
a
                            , Int -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr Int
size
                            , Int -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (CIRegs -> Int
regTag CIRegs
regs)
                            , CIStatic -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr CIStatic
static
                            ]
  where
    regTag :: CIRegs -> Int
regTag CIRegs
CIRegsUnknown       = -Int
1
    regTag (CIRegs Int
skip [JSRep]
types) =
      let nregs :: Int
nregs = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (JSRep -> Int) -> [JSRep] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JSRep -> Int
varSize [JSRep]
types
      in  Int
skip Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
nregs Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`Bits.shiftL` Int
8)

-- | Special case of closures that do not need to generate any @fresh@ names
closure :: ClosureInfo    -- ^ object being info'd see @ciVar@
         -> (JSM JStgStat) -- ^ rhs
         -> JSM JStgStat
closure :: ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure ClosureInfo
ci JSM JStgStat
body = do f <- (Ident -> JSM JStgStat -> JSM JStgStat
jFunction' (ClosureInfo -> Ident
ciVar ClosureInfo
ci) JSM JStgStat
body)
                     return $ f `mappend` closureInfoStat False ci

conClosure :: Ident -> FastString -> CILayout -> Int -> JSM JStgStat
conClosure :: Ident -> FastString -> CILayout -> Int -> JSM JStgStat
conClosure Ident
symbol FastString
name CILayout
layout Int
constr = ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure ClosureInfo
ci JSM JStgStat
body
  where
    ci :: ClosureInfo
ci = (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
symbol (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
name CILayout
layout (Int -> CIType
CICon Int
constr) CIStatic
forall a. Monoid a => a
mempty)
    body :: JSM JStgStat
body   = JStgStat -> JSM JStgStat
forall a. a -> StateT JEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JStgStat -> JSM JStgStat)
-> (JStgExpr -> JStgStat) -> JStgExpr -> JSM JStgStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JStgExpr -> JStgStat
returnS (JStgExpr -> JSM JStgStat) -> JStgExpr -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$ JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp

-- | Used to pass arguments to newClosure with some safety
data Closure = Closure
  { Closure -> JStgExpr
clEntry  :: JStgExpr
  , Closure -> JStgExpr
clField1 :: JStgExpr
  , Closure -> JStgExpr
clField2 :: JStgExpr
  , Closure -> JStgExpr
clMeta   :: JStgExpr
  , Closure -> Maybe JStgExpr
clCC     :: Maybe JStgExpr
  }

newClosure :: Closure -> JStgExpr
newClosure :: Closure -> JStgExpr
newClosure Closure{Maybe JStgExpr
JStgExpr
clEntry :: Closure -> JStgExpr
clField1 :: Closure -> JStgExpr
clField2 :: Closure -> JStgExpr
clMeta :: Closure -> JStgExpr
clCC :: Closure -> Maybe JStgExpr
clEntry :: JStgExpr
clField1 :: JStgExpr
clField2 :: JStgExpr
clMeta :: JStgExpr
clCC :: Maybe JStgExpr
..} =
  let xs :: [(FastString, JStgExpr)]
xs = [ (FastString
closureEntry_ , JStgExpr
clEntry)
           , (FastString
closureField1_, JStgExpr
clField1)
           , (FastString
closureField2_, JStgExpr
clField2)
           , (FastString
closureMeta_  , JStgExpr
clMeta)
           ]
  in case Maybe JStgExpr
clCC of
    -- CC field is optional (probably to minimize code size as we could assign
    -- null_, but we get the same effect implicitly)
    Maybe JStgExpr
Nothing -> JVal -> JStgExpr
ValExpr ([(FastString, JStgExpr)] -> JVal
jhFromList [(FastString, JStgExpr)]
xs)
    Just JStgExpr
cc -> JVal -> JStgExpr
ValExpr ([(FastString, JStgExpr)] -> JVal
jhFromList ([(FastString, JStgExpr)] -> JVal)
-> [(FastString, JStgExpr)] -> JVal
forall a b. (a -> b) -> a -> b
$ (FastString
closureCC_,JStgExpr
cc) (FastString, JStgExpr)
-> [(FastString, JStgExpr)] -> [(FastString, JStgExpr)]
forall a. a -> [a] -> [a]
: [(FastString, JStgExpr)]
xs)

assignClosure :: JStgExpr -> Closure -> JStgStat
assignClosure :: JStgExpr -> Closure -> JStgStat
assignClosure JStgExpr
t Closure{Maybe JStgExpr
JStgExpr
clEntry :: Closure -> JStgExpr
clField1 :: Closure -> JStgExpr
clField2 :: Closure -> JStgExpr
clMeta :: Closure -> JStgExpr
clCC :: Closure -> Maybe JStgExpr
clEntry :: JStgExpr
clField1 :: JStgExpr
clField2 :: JStgExpr
clMeta :: JStgExpr
clCC :: Maybe JStgExpr
..} = [JStgStat] -> JStgStat
BlockStat
  [ JStgExpr -> JStgExpr
closureEntry  JStgExpr
t JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
clEntry
  , JStgExpr -> JStgExpr
closureField1 JStgExpr
t JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
clField1
  , JStgExpr -> JStgExpr
closureField2 JStgExpr
t JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
clField2
  , JStgExpr -> JStgExpr
closureMeta   JStgExpr
t JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
clMeta
  ] JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> case Maybe JStgExpr
clCC of
      Maybe JStgExpr
Nothing -> JStgStat
forall a. Monoid a => a
mempty
      Just JStgExpr
cc -> JStgExpr -> JStgExpr
closureCC JStgExpr
t JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
cc

data CopyCC = CopyCC | DontCopyCC

copyClosure :: CopyCC -> JStgExpr -> JStgExpr -> JStgStat
copyClosure :: CopyCC -> JStgExpr -> JStgExpr -> JStgStat
copyClosure CopyCC
copy_cc JStgExpr
t JStgExpr
s = [JStgStat] -> JStgStat
BlockStat
  [ JStgExpr -> JStgExpr
closureEntry  JStgExpr
t JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureEntry  JStgExpr
s
  , JStgExpr -> JStgExpr
closureField1 JStgExpr
t JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField1 JStgExpr
s
  , JStgExpr -> JStgExpr
closureField2 JStgExpr
t JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField2 JStgExpr
s
  , JStgExpr -> JStgExpr
closureMeta   JStgExpr
t JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureMeta   JStgExpr
s
  ] JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> case CopyCC
copy_cc of
      CopyCC
DontCopyCC -> JStgStat
forall a. Monoid a => a
mempty
      CopyCC
CopyCC     -> JStgExpr -> JStgExpr
closureCC JStgExpr
t JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureCC JStgExpr
s

mkClosure :: JStgExpr -> [JStgExpr] -> JStgExpr -> Maybe JStgExpr -> Closure
mkClosure :: JStgExpr -> [JStgExpr] -> JStgExpr -> Maybe JStgExpr -> Closure
mkClosure JStgExpr
entry [JStgExpr]
fields JStgExpr
meta Maybe JStgExpr
cc = Closure
  { clEntry :: JStgExpr
clEntry  = JStgExpr
entry
  , clField1 :: JStgExpr
clField1 = JStgExpr
x1
  , clField2 :: JStgExpr
clField2 = JStgExpr
x2
  , clMeta :: JStgExpr
clMeta   = JStgExpr
meta
  , clCC :: Maybe JStgExpr
clCC     = Maybe JStgExpr
cc
  }
  where
    x1 :: JStgExpr
x1 = case [JStgExpr]
fields of
           []  -> JStgExpr
null_
           JStgExpr
x:[JStgExpr]
_ -> JStgExpr
x
    x2 :: JStgExpr
x2 = case [JStgExpr]
fields of
           []     -> JStgExpr
null_
           [JStgExpr
_]    -> JStgExpr
null_
           [JStgExpr
_,JStgExpr
x]  -> JStgExpr
x
           JStgExpr
_:JStgExpr
x:[JStgExpr]
xs -> JVal -> JStgExpr
ValExpr (JVal -> JStgExpr)
-> ([(FastString, JStgExpr)] -> JVal)
-> [(FastString, JStgExpr)]
-> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqMap FastString JStgExpr -> JVal
JHash (UniqMap FastString JStgExpr -> JVal)
-> ([(FastString, JStgExpr)] -> UniqMap FastString JStgExpr)
-> [(FastString, JStgExpr)]
-> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FastString, JStgExpr)] -> UniqMap FastString JStgExpr
forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap ([(FastString, JStgExpr)] -> JStgExpr)
-> [(FastString, JStgExpr)] -> JStgExpr
forall a b. (a -> b) -> a -> b
$ [FastString] -> [JStgExpr] -> [(FastString, JStgExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> FastString) -> [Int] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> FastString
dataFieldName [Int
1..]) (JStgExpr
xJStgExpr -> [JStgExpr] -> [JStgExpr]
forall a. a -> [a] -> [a]
:[JStgExpr]
xs)


-------------------------------------------------------------------------------
--                             Name Caches
-------------------------------------------------------------------------------
-- $names

-- | Cache "dXXX" field names
dataFieldCache :: Array Int FastString
dataFieldCache :: Array Int FastString
dataFieldCache = (Int, Int) -> [FastString] -> Array Int FastString
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
nFieldCache) ((Int -> FastString) -> [Int] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> FastString
mkFastString ([Char] -> FastString) -> (Int -> [Char]) -> Int -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'd'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> (Int -> [Char]) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show) [(Int
0::Int)..Int
nFieldCache])

-- | Data names are used in the AST, and logging has determined that 255 is the maximum number we see.
nFieldCache :: Int
nFieldCache :: Int
nFieldCache  = Int
255

-- | We use this in the RTS to determine the number of generated closures. These closures use the names
-- cached here, so we bind them to the same number.
jsClosureCount :: Int
jsClosureCount :: Int
jsClosureCount  = Int
24

dataFieldName :: Int -> FastString
dataFieldName :: Int -> FastString
dataFieldName Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
nFieldCache = [Char] -> FastString
mkFastString (Char
'd' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)
  | Bool
otherwise                = Array Int FastString
dataFieldCache Array Int FastString -> Int -> FastString
forall i e. Ix i => Array i e -> i -> e
! Int
i

-- | Cache "h$dXXX" names
dataCache :: Array Int FastString
dataCache :: Array Int FastString
dataCache = (Int, Int) -> [FastString] -> Array Int FastString
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
jsClosureCount) ((Int -> FastString) -> [Int] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> FastString
mkFastString ([Char] -> FastString) -> (Int -> [Char]) -> Int -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"h$d"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> (Int -> [Char]) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show) [(Int
0::Int)..Int
jsClosureCount])

dataName :: Int -> FastString
dataName :: Int -> FastString
dataName Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
nFieldCache = [Char] -> FastString
mkFastString ([Char]
"h$d" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)
  | Bool
otherwise                = Array Int FastString
dataCache Array Int FastString -> Int -> FastString
forall i e. Ix i => Array i e -> i -> e
! Int
i

allocData :: Int -> JStgExpr
allocData :: Int -> JStgExpr
allocData Int
i = Ident -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (FastString -> Ident
global (Int -> FastString
dataName Int
i))

-- | Cache "h$cXXX" names
clsCache :: Array Int FastString
clsCache :: Array Int FastString
clsCache = (Int, Int) -> [FastString] -> Array Int FastString
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
jsClosureCount) ((Int -> FastString) -> [Int] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> FastString
mkFastString ([Char] -> FastString) -> (Int -> [Char]) -> Int -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"h$c"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> (Int -> [Char]) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show) [(Int
0::Int)..Int
jsClosureCount])

clsName :: Int -> FastString
clsName :: Int -> FastString
clsName Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
jsClosureCount = [Char] -> FastString
mkFastString ([Char]
"h$c" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)
  | Bool
otherwise                   = Array Int FastString
clsCache Array Int FastString -> Int -> FastString
forall i e. Ix i => Array i e -> i -> e
! Int
i

allocClsA :: Int -> JStgExpr
allocClsA :: Int -> JStgExpr
allocClsA Int
i = Ident -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (FastString -> Ident
global (Int -> FastString
clsName Int
i))

-- | Cache "xXXX" names
varCache :: Array Int Ident
varCache :: Array Int Ident
varCache = (Int, Int) -> [Ident] -> Array Int Ident
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
jsClosureCount) ((Int -> Ident) -> [Int] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FastString -> Ident
global (FastString -> Ident) -> (Int -> FastString) -> Int -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> FastString
mkFastString ([Char] -> FastString) -> (Int -> [Char]) -> Int -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'x'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> (Int -> [Char]) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show) [(Int
0::Int)..Int
jsClosureCount])

varName :: Int -> Ident
varName :: Int -> Ident
varName Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
jsClosureCount = FastString -> Ident
global (FastString -> Ident) -> FastString -> Ident
forall a b. (a -> b) -> a -> b
$ [Char] -> FastString
mkFastString (Char
'x' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)
  | Bool
otherwise                   = Array Int Ident
varCache Array Int Ident -> Int -> Ident
forall i e. Ix i => Array i e -> i -> e
! Int
i