{-# 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.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

-- | Generate statements to set infotable field values for the given ClosureInfo
--
-- Depending on debug flag, it generates h$setObjInfo(...) or h$o(...). The
-- latter form doesn't store the pretty-printed name in the closure to save
-- space.
closureInfoStat :: Bool -> ClosureInfo -> JStgStat
closureInfoStat :: Bool -> ClosureInfo -> JStgStat
closureInfoStat Bool
debug ClosureInfo
ci
  = Bool
-> Ident
-> CIRegs
-> CILayout
-> ClosureType
-> FastString
-> Int
-> CIStatic
-> JStgStat
setObjInfoL Bool
debug (ClosureInfo -> Ident
ciVar ClosureInfo
ci) (ClosureInfo -> CIRegs
ciRegs ClosureInfo
ci) (ClosureInfo -> CILayout
ciLayout ClosureInfo
ci) ClosureType
ty (ClosureInfo -> FastString
ciName ClosureInfo
ci) Int
tag (ClosureInfo -> CIStatic
ciStatic ClosureInfo
ci)
      where
        !ty :: ClosureType
ty = case ClosureInfo -> CIType
ciType ClosureInfo
ci 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 ClosureInfo -> CIType
ciType ClosureInfo
ci 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 = ClosureInfo
          { ciVar :: Ident
ciVar = Ident
symbol
          , ciRegs :: CIRegs
ciRegs = Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]
          , ciName :: FastString
ciName = FastString
name
          , ciLayout :: CILayout
ciLayout = CILayout
layout
          , ciType :: CIType
ciType = Int -> CIType
CICon Int
constr
          , ciStatic :: CIStatic
ciStatic = 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
returnStack

-- | Used to pass arguments to newClosure with some safety
data Closure = Closure
  { Closure -> JStgExpr
clInfo   :: JStgExpr        -- ^ InfoTable object
  , Closure -> JStgExpr
clField1 :: JStgExpr        -- ^ Payload field 1
  , Closure -> JStgExpr
clField2 :: JStgExpr        -- ^ Payload field 2
  , Closure -> JStgExpr
clMeta   :: JStgExpr
  , Closure -> Maybe JStgExpr
clCC     :: Maybe JStgExpr
  }

newClosure :: Closure -> JStgExpr
newClosure :: Closure -> JStgExpr
newClosure Closure{Maybe JStgExpr
JStgExpr
clInfo :: Closure -> JStgExpr
clField1 :: Closure -> JStgExpr
clField2 :: Closure -> JStgExpr
clMeta :: Closure -> JStgExpr
clCC :: Closure -> Maybe JStgExpr
clInfo :: JStgExpr
clField1 :: JStgExpr
clField2 :: JStgExpr
clMeta :: JStgExpr
clCC :: Maybe JStgExpr
..} =
  let xs :: [(FastString, JStgExpr)]
xs = [ (FastString
closureInfo_  , JStgExpr
clInfo)
           , (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
clInfo :: Closure -> JStgExpr
clField1 :: Closure -> JStgExpr
clField2 :: Closure -> JStgExpr
clMeta :: Closure -> JStgExpr
clCC :: Closure -> Maybe JStgExpr
clInfo :: JStgExpr
clField1 :: JStgExpr
clField2 :: JStgExpr
clMeta :: JStgExpr
clCC :: Maybe JStgExpr
..} = [JStgStat] -> JStgStat
BlockStat
  [ JStgExpr -> JStgExpr
closureInfo   JStgExpr
t JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
clInfo
  , 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
closureInfo   JStgExpr
t JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureInfo   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
info [JStgExpr]
fields JStgExpr
meta Maybe JStgExpr
cc = Closure
  { clInfo :: JStgExpr
clInfo   = JStgExpr
info
  , 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 = JStgExpr -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (FastString -> JStgExpr
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 = JStgExpr -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (FastString -> JStgExpr
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
name (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
name (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