{-# LANGUAGE CPP               #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms   #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -fno-warn-orphans #-} -- only for Num, Fractional on JStgExpr

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.JS.Make
-- 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
--
--
-- * Domain and Purpose
--
--     GHC.JS.Make defines helper functions to ease the creation of JavaScript
--     ASTs as defined in 'GHC.JS.Syntax'. Its purpose is twofold: make the EDSL
--     more ergonomic to program in, and make errors in the EDSL /look/ obvious
--     because the EDSL is untyped. It is primarily concerned with injecting
--     terms into the domain of the EDSL to construct JS programs in Haskell.
--
-- * Strategy
--
--     The strategy for this module comes straight from gentzen; where we have
--     two types of helper functions. Functions which inject terms into the
--     EDSL, and combinator functions which operate on terms in the EDSL to
--     construct new terms in the EDSL. Crucially, missing from this module are
--     corresponding /elimination/ or /destructing/ functions which would
--     project information from the EDSL back to Haskell. See
--     'GHC.StgToJS.Utils' for such functions.
--
--      * /Introduction/ functions
--
--           We define various primitive helpers which /introduce/ terms in the
--           EDSL, for example 'jVar', 'jLam', and 'var' and 'jString'.
--           Similarly this module exports four typeclasses 'ToExpr', 'ToStat',
--           'JVarMagic', 'JSArgument'. 'ToExpr' injects values as a JS
--           expression into the EDSL. 'ToStat' injects values as JS statements
--           into the EDSL. @JVarMagic@ provides a polymorphic way to introduce
--           a new name into the EDSL and @JSArgument@ provides a polymorphic
--           way to bind variable names for use in JS functions with different
--           arities.
--
--      * /Combinator/ functions
--
--           The rest of the module defines combinators which create terms in
--           the EDSL from terms in the EDSL. Notable examples are '|=' and
--           '||=', '|=' is sugar for 'AssignStat', it is a binding form that
--           declares @foo = bar@ /assuming/ foo has been already declared.
--           '||=' is more sugar on top of '|=', it is also a binding form that
--           declares the LHS of '|=' before calling '|=' to bind a value, bar,
--           to a variable foo. Other common examples are the 'if_' and 'math_'
--           helpers such as 'math_cos'.
--
-- * Consumers
--
--     The entire JS backend consumes this module, e.g., the modules in
--     GHC.StgToJS.\*.
--
-- * Notation
--
--     In this module we use @==>@ in docstrings to show the translation from
--     the JS EDSL domain to JS code. For example, @foo ||= bar ==> var foo; foo
--     = bar;@ should be read as @foo ||= bar@ is in the EDSL domain and results
--     in the JS code @var foo; foo = bar;@ when compiled.
--
--     In most cases functions prefixed with a 'j' are monadic because the
--     observably allocate. Notable exceptions are `jwhenS`, 'jString' and the
--     helpers for HashMaps.
-----------------------------------------------------------------------------
module GHC.JS.Make
  ( -- * Injection Type classes
    -- $classes
    ToJExpr(..)
  , ToStat(..)
  , JVarMagic(..)
  , JSArgument(..)
  -- * Introduction functions
  -- $intro_funcs
  , jString
  , jLam, jLam', jFunction, jFunctionSized, jFunction'
  , jVar, jVars, jFor, jForIn, jForEachIn, jTryCatchFinally
  -- * Combinators
  -- $combinators
  , (||=), (|=), (.==.), (.===.), (.!=.), (.!==.), (.!)
  , (.>.), (.>=.), (.<.), (.<=.)
  , (.<<.), (.>>.), (.>>>.)
  , (.|.), (.||.), (.&&.)
  , if_, if10, if01, ifS, ifBlockS, jBlock, jIf
  , jwhenS
  , app, appS, returnS
  , loop, loopBlockS
  , preIncrS, postIncrS
  , preDecrS, postDecrS
  , off8, off16, off32, off64
  , mask8, mask16
  , signExtend8, signExtend16
  , typeof
  , returnStack, assignAllEqual, assignAll, assignAllReverseOrder
  , declAssignAll
  , nullStat, (.^)
  , trace
  -- ** Hash combinators
  , jhEmpty
  , jhSingle
  , jhAdd
  , jhFromList
  -- * Literals
  -- $literals
  , null_
  , undefined_
  , false_
  , true_
  , zero_
  , one_
  , two_
  , three_
  -- ** Math functions
  -- $math
  , math_log, math_sin, math_cos, math_tan, math_exp, math_acos, math_asin,
    math_atan, math_abs, math_pow, math_sqrt, math_asinh, math_acosh, math_atanh,
    math_cosh, math_sinh, math_tanh, math_expm1, math_log1p, math_fround
  -- * Statement helpers
  , Solo(..)
  , decl
#if __GLASGOW_HASKELL__ < 905
  , pattern MkSolo
#endif
  )
where

import GHC.Prelude hiding ((.|.))

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

import Control.Arrow ((***))
import Control.Monad (replicateM)
import Data.Tuple

import qualified Data.Map as M

import GHC.Data.FastString
import GHC.Utils.Misc
import GHC.Types.Unique.Map

--------------------------------------------------------------------------------
--                        Type Classes
--------------------------------------------------------------------------------
-- $classes
-- The 'ToJExpr' class handles injection of of things into the EDSL as a JS
-- expression

-- | Things that can be marshalled into javascript values.
-- Instantiate for any necessary data structures.
class ToJExpr a where
    toJExpr         :: a   -> JStgExpr
    toJExprFromList :: [a] -> JStgExpr
    toJExprFromList = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr) -> ([a] -> JVal) -> [a] -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JStgExpr] -> JVal
JList ([JStgExpr] -> JVal) -> ([a] -> [JStgExpr]) -> [a] -> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> JStgExpr) -> [a] -> [JStgExpr]
forall a b. (a -> b) -> [a] -> [b]
map a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr

instance ToJExpr a => ToJExpr [a] where
    toJExpr :: [a] -> JStgExpr
toJExpr = [a] -> JStgExpr
forall a. ToJExpr a => [a] -> JStgExpr
toJExprFromList

instance ToJExpr JStgExpr where
    toJExpr :: JStgExpr -> JStgExpr
toJExpr = JStgExpr -> JStgExpr
forall a. a -> a
id

instance ToJExpr () where
    toJExpr :: () -> JStgExpr
toJExpr ()
_ = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr) -> JVal -> JStgExpr
forall a b. (a -> b) -> a -> b
$ [JStgExpr] -> JVal
JList []

instance ToJExpr Bool where
    toJExpr :: Bool -> JStgExpr
toJExpr Bool
True  = FastString -> JStgExpr
var FastString
"true"
    toJExpr Bool
False = FastString -> JStgExpr
var FastString
"false"

instance ToJExpr JVal where
    toJExpr :: JVal -> JStgExpr
toJExpr = JVal -> JStgExpr
ValExpr

instance ToJExpr a => ToJExpr (UniqMap FastString a) where
    toJExpr :: UniqMap FastString a -> JStgExpr
toJExpr = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr)
-> (UniqMap FastString a -> JVal)
-> UniqMap FastString a
-> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqMap FastString JStgExpr -> JVal
JHash (UniqMap FastString JStgExpr -> JVal)
-> (UniqMap FastString a -> UniqMap FastString JStgExpr)
-> UniqMap FastString a
-> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> JStgExpr)
-> UniqMap FastString a -> UniqMap FastString JStgExpr
forall a b k. (a -> b) -> UniqMap k a -> UniqMap k b
mapUniqMap a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr

instance ToJExpr a => ToJExpr (M.Map String a) where
    toJExpr :: Map String a -> JStgExpr
toJExpr = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr)
-> (Map String a -> JVal) -> Map String a -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqMap FastString JStgExpr -> JVal
JHash (UniqMap FastString JStgExpr -> JVal)
-> (Map String a -> UniqMap FastString JStgExpr)
-> Map String a
-> 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)] -> UniqMap FastString JStgExpr)
-> (Map String a -> [(FastString, JStgExpr)])
-> Map String a
-> UniqMap FastString JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, a) -> (FastString, JStgExpr))
-> [(String, a)] -> [(FastString, JStgExpr)]
forall a b. (a -> b) -> [a] -> [b]
map (String -> FastString
mkFastString (String -> FastString)
-> (a -> JStgExpr) -> (String, a) -> (FastString, JStgExpr)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr) ([(String, a)] -> [(FastString, JStgExpr)])
-> (Map String a -> [(String, a)])
-> Map String a
-> [(FastString, JStgExpr)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String a -> [(String, a)]
forall k a. Map k a -> [(k, a)]
M.toList

instance ToJExpr Double where
    toJExpr :: Double -> JStgExpr
toJExpr = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr) -> (Double -> JVal) -> Double -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SaneDouble -> JVal
JDouble (SaneDouble -> JVal) -> (Double -> SaneDouble) -> Double -> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> SaneDouble
SaneDouble

instance ToJExpr Int where
    toJExpr :: Int -> JStgExpr
toJExpr = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr) -> (Int -> JVal) -> Int -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> JVal
JInt (Integer -> JVal) -> (Int -> Integer) -> Int -> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance ToJExpr Integer where
    toJExpr :: Integer -> JStgExpr
toJExpr = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr) -> (Integer -> JVal) -> Integer -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> JVal
JInt

instance ToJExpr Char where
    toJExpr :: Char -> JStgExpr
toJExpr = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr) -> (Char -> JVal) -> Char -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> JVal
JStr (FastString -> JVal) -> (Char -> FastString) -> Char -> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString (String -> FastString) -> (Char -> String) -> Char -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
:[])
    toJExprFromList :: String -> JStgExpr
toJExprFromList = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr) -> (String -> JVal) -> String -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> JVal
JStr (FastString -> JVal) -> (String -> FastString) -> String -> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString
--        where escQuotes = tailDef "" . initDef "" . show

instance ToJExpr Ident where
    toJExpr :: Ident -> JStgExpr
toJExpr = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr) -> (Ident -> JVal) -> Ident -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> JVal
JVar

instance ToJExpr FastString where
    toJExpr :: FastString -> JStgExpr
toJExpr = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr)
-> (FastString -> JVal) -> FastString -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> JVal
JStr

instance (ToJExpr a, ToJExpr b) => ToJExpr (a,b) where
    toJExpr :: (a, b) -> JStgExpr
toJExpr (a
a,b
b) = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr)
-> ([JStgExpr] -> JVal) -> [JStgExpr] -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JStgExpr] -> JVal
JList ([JStgExpr] -> JStgExpr) -> [JStgExpr] -> JStgExpr
forall a b. (a -> b) -> a -> b
$ [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
a, b -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr b
b]

instance (ToJExpr a, ToJExpr b, ToJExpr c) => ToJExpr (a,b,c) where
    toJExpr :: (a, b, c) -> JStgExpr
toJExpr (a
a,b
b,c
c) = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr)
-> ([JStgExpr] -> JVal) -> [JStgExpr] -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JStgExpr] -> JVal
JList ([JStgExpr] -> JStgExpr) -> [JStgExpr] -> JStgExpr
forall a b. (a -> b) -> a -> b
$ [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
a, b -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr b
b, c -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr c
c]

instance (ToJExpr a, ToJExpr b, ToJExpr c, ToJExpr d) => ToJExpr (a,b,c,d) where
    toJExpr :: (a, b, c, d) -> JStgExpr
toJExpr (a
a,b
b,c
c,d
d) = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr)
-> ([JStgExpr] -> JVal) -> [JStgExpr] -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JStgExpr] -> JVal
JList ([JStgExpr] -> JStgExpr) -> [JStgExpr] -> JStgExpr
forall a b. (a -> b) -> a -> b
$ [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
a, b -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr b
b, c -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr c
c, d -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr d
d]
instance (ToJExpr a, ToJExpr b, ToJExpr c, ToJExpr d, ToJExpr e) => ToJExpr (a,b,c,d,e) where
    toJExpr :: (a, b, c, d, e) -> JStgExpr
toJExpr (a
a,b
b,c
c,d
d,e
e) = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr)
-> ([JStgExpr] -> JVal) -> [JStgExpr] -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JStgExpr] -> JVal
JList ([JStgExpr] -> JStgExpr) -> [JStgExpr] -> JStgExpr
forall a b. (a -> b) -> a -> b
$ [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
a, b -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr b
b, c -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr c
c, d -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr d
d, e -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr e
e]
instance (ToJExpr a, ToJExpr b, ToJExpr c, ToJExpr d, ToJExpr e, ToJExpr f) => ToJExpr (a,b,c,d,e,f) where
    toJExpr :: (a, b, c, d, e, f) -> JStgExpr
toJExpr (a
a,b
b,c
c,d
d,e
e,f
f) = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr)
-> ([JStgExpr] -> JVal) -> [JStgExpr] -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JStgExpr] -> JVal
JList ([JStgExpr] -> JStgExpr) -> [JStgExpr] -> JStgExpr
forall a b. (a -> b) -> a -> b
$ [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
a, b -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr b
b, c -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr c
c, d -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr d
d, e -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr e
e, f -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr f
f]


-- | The 'ToStat' class handles injection of of things into the EDSL as a JS
-- statement. This ends up being polymorphic sugar for JS blocks, see helper
-- function 'GHC.JS.Make.expr2stat'. Instantiate for any necessary data
-- structures.
class ToStat a where
    toStat :: a -> JStgStat

instance ToStat JStgStat where
    toStat :: JStgStat -> JStgStat
toStat = JStgStat -> JStgStat
forall a. a -> a
id

instance ToStat [JStgStat] where
    toStat :: [JStgStat] -> JStgStat
toStat = [JStgStat] -> JStgStat
BlockStat

instance ToStat JStgExpr where
    toStat :: JStgExpr -> JStgStat
toStat = JStgExpr -> JStgStat
expr2stat

instance ToStat [JStgExpr] where
    toStat :: [JStgExpr] -> JStgStat
toStat = [JStgStat] -> JStgStat
BlockStat ([JStgStat] -> JStgStat)
-> ([JStgExpr] -> [JStgStat]) -> [JStgExpr] -> JStgStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JStgExpr -> JStgStat) -> [JStgExpr] -> [JStgStat]
forall a b. (a -> b) -> [a] -> [b]
map JStgExpr -> JStgStat
expr2stat

-- | Convert A JS expression to a JS statement where applicable. This only
-- affects applications; 'ApplExpr', If-expressions; 'IfExpr', and Unary
-- expression; 'UOpExpr'.
expr2stat :: JStgExpr -> JStgStat
expr2stat :: JStgExpr -> JStgStat
expr2stat (ApplExpr JStgExpr
x [JStgExpr]
y) = (JStgExpr -> [JStgExpr] -> JStgStat
ApplStat JStgExpr
x [JStgExpr]
y)
expr2stat (IfExpr JStgExpr
x JStgExpr
y JStgExpr
z) = JStgExpr -> JStgStat -> JStgStat -> JStgStat
IfStat JStgExpr
x (JStgExpr -> JStgStat
expr2stat JStgExpr
y) (JStgExpr -> JStgStat
expr2stat JStgExpr
z)
expr2stat (UOpExpr UOp
o JStgExpr
x) = UOp -> JStgExpr -> JStgStat
UOpStat UOp
o JStgExpr
x
expr2stat JStgExpr
_ = JStgStat
nullStat

--------------------------------------------------------------------------------
--                        Introduction Functions
--------------------------------------------------------------------------------
-- $intro_functions
-- Introduction functions are functions that map values or terms in the Haskell
-- domain to the JS EDSL domain

-- | Create a new anonymous function. The result is a 'GHC.JS.Syntax.JExpr'
-- expression.
-- Usage:
--
-- > jLam $ \x -> jVar x + one_
-- > jLam $ \f -> (jLam $ \x -> (f `app` (x `app` x))) `app` (jLam $ \x -> (f `app` (x `app` x)))
jLam :: JSArgument args => (args -> JSM JStgStat) -> JSM JStgExpr
jLam :: forall args.
JSArgument args =>
(args -> JSM JStgStat) -> JSM JStgExpr
jLam args -> JSM JStgStat
body = do xs <- JSM args
forall args. JSArgument args => JSM args
args
               ValExpr . JFunc (argList xs) <$> body xs

-- | Special case of @jLam@ where the anonymous function requires no fresh
-- arguments.
jLam' :: JStgStat -> JStgExpr
jLam' :: JStgStat -> JStgExpr
jLam' JStgStat
body = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr) -> JVal -> JStgExpr
forall a b. (a -> b) -> a -> b
$ [Ident] -> JStgStat -> JVal
JFunc [Ident]
forall a. Monoid a => a
mempty JStgStat
body

-- | Introduce only one new variable into scope for the duration of the
-- enclosed expression. The result is a block statement. Usage:
--
-- 'jVar $ \x -> mconcat [jVar x ||= one_, ...'
jVar :: (JVarMagic t, ToJExpr t) => (t -> JSM JStgStat) -> JSM JStgStat
jVar :: forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar t -> JSM JStgStat
f = (Solo t -> JSM JStgStat) -> JSM JStgStat
forall args.
JSArgument args =>
(args -> JSM JStgStat) -> JSM JStgStat
jVars ((Solo t -> JSM JStgStat) -> JSM JStgStat)
-> (Solo t -> JSM JStgStat) -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$ \(MkSolo t
only_one) -> t -> JSM JStgStat
f t
only_one

-- | Introduce one or many new variables into scope for the duration of the
-- enclosed expression. This function reifies the number of arguments based on
-- the container of the input function. We intentionally avoid lists and instead
-- opt for tuples because lists are not sized in general. The result is a block
-- statement. Usage:
--
-- @jVars $ \(x,y) -> mconcat [ x |= one_,  y |= two_,  x + y]@
jVars :: (JSArgument args) => (args -> JSM JStgStat) -> JSM JStgStat
jVars :: forall args.
JSArgument args =>
(args -> JSM JStgStat) -> JSM JStgStat
jVars args -> JSM JStgStat
f = do as   <- JSM args
forall args. JSArgument args => JSM args
args
             body <- f as
             return $ mconcat $ fmap decl (argList as) ++ [body]

-- | Construct a top-level function subject to JS hoisting. This combinator is
-- polymorphic over function arity so you can you use to define a JS syntax
-- object in Haskell, which is a function in JS that takes 2 or 4 or whatever
-- arguments. For a singleton function use the @Solo@ constructor @MkSolo@.
-- Usage:
--
-- an example from the Rts that defines a 1-arity JS function
-- > jFunction (global "h$getReg") (\(MkSolo n) -> return $ SwitchStat n getRegCases mempty)
--
-- an example of a two argument function from the Rts
-- > jFunction (global "h$bh_lne") (\(x, frameSize) -> bhLneStats s x frameSize)
jFunction
  :: (JSArgument args)
  => Ident                  -- ^ global name
  -> (args -> JSM JStgStat) -- ^ function body, input is locally unique generated variables
  -> JSM JStgStat
jFunction :: forall args.
JSArgument args =>
Ident -> (args -> JSM JStgStat) -> JSM JStgStat
jFunction Ident
name args -> JSM JStgStat
body = do
  func_args <- JSM args
forall args. JSArgument args => JSM args
args
  FuncStat name (argList func_args) <$> (body func_args)

-- | Construct a top-level function subject to JS hoisting. Special case where
-- the arity cannot be deduced from the 'args' parameter (atleast not without
-- dependent types).
jFunctionSized
  :: Ident                        -- ^ global name
  -> Int                          -- ^ Arity
  -> ([JStgExpr] -> JSM JStgStat) -- ^ function body, input is locally unique generated variables
  -> JSM JStgStat
jFunctionSized :: Ident -> Int -> ([JStgExpr] -> JSM JStgStat) -> JSM JStgStat
jFunctionSized Ident
name Int
arity [JStgExpr] -> JSM JStgStat
body = do
  func_args <- Int -> StateT JEnv Identity Ident -> StateT JEnv Identity [Ident]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
arity StateT JEnv Identity Ident
newIdent
  FuncStat name func_args <$> (body $ toJExpr <$> func_args)

-- | Construct a top-level function subject to JS hoisting. Special case where
-- the function binds no parameters
jFunction'
  :: Ident        -- ^ global name
  -> JSM JStgStat -- ^ function body, input is locally unique generated variables
  -> JSM JStgStat
jFunction' :: Ident -> JSM JStgStat -> JSM JStgStat
jFunction' Ident
name JSM JStgStat
body = Ident -> [Ident] -> JStgStat -> JStgStat
FuncStat Ident
name [Ident]
forall a. Monoid a => a
mempty (JStgStat -> JStgStat) -> JSM JStgStat -> JSM JStgStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM JStgStat
body

jBlock :: Monoid a => [JSM a] -> JSM a
jBlock :: forall a. Monoid a => [JSM a] -> JSM a
jBlock =  ([a] -> a) -> StateT JEnv Identity [a] -> StateT JEnv Identity a
forall a b.
(a -> b) -> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall a. Monoid a => [a] -> a
mconcat (StateT JEnv Identity [a] -> StateT JEnv Identity a)
-> ([StateT JEnv Identity a] -> StateT JEnv Identity [a])
-> [StateT JEnv Identity a]
-> StateT JEnv Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StateT JEnv Identity a] -> StateT JEnv Identity [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence

-- | Create a 'for in' statement.
-- Usage:
--
-- @jForIn {expression} $ \x -> {block involving x}@
jForIn :: JStgExpr -> (JStgExpr -> JStgStat) -> JSM JStgStat
jForIn :: JStgExpr -> (JStgExpr -> JStgStat) -> JSM JStgStat
jForIn JStgExpr
e JStgExpr -> JStgStat
f = do
  i <- StateT JEnv Identity Ident
newIdent
  return $ decl i `mappend` ForInStat False i e (f (ValExpr $! JVar i))

-- | As with "jForIn" but creating a \"for each in\" statement.
jForEachIn :: JStgExpr -> (JStgExpr -> JStgStat) -> JSM JStgStat
jForEachIn :: JStgExpr -> (JStgExpr -> JStgStat) -> JSM JStgStat
jForEachIn JStgExpr
e JStgExpr -> JStgStat
f = do i     <- StateT JEnv Identity Ident
newIdent
                    return $ decl i `mappend` ForInStat True i e (f (ValExpr $! JVar i))

-- | Create a 'for' statement given a function for initialization, a predicate
-- to step to, a step and a body
-- Usage:
--
-- @ jFor (|= zero_) (.<. Int 65536) preIncrS
--        (\j -> ...something with the counter j...)@
--
jFor :: (JStgExpr -> JStgStat) -- ^ initialization function
     -> (JStgExpr -> JStgExpr) -- ^ predicate
     -> (JStgExpr -> JStgStat) -- ^ step function
     -> (JStgExpr -> JStgStat) -- ^ body
     -> JSM JStgStat
jFor :: (JStgExpr -> JStgStat)
-> (JStgExpr -> JStgExpr)
-> (JStgExpr -> JStgStat)
-> (JStgExpr -> JStgStat)
-> JSM JStgStat
jFor JStgExpr -> JStgStat
init JStgExpr -> JStgExpr
pred JStgExpr -> JStgStat
step JStgExpr -> JStgStat
body = do id <- StateT JEnv Identity Ident
newIdent
                              let i = JVal -> JStgExpr
ValExpr (Ident -> JVal
JVar Ident
id)
                              return
                                $ decl id `mappend` ForStat (init i) (pred i) (step i) (body i)

-- | As with "jForIn" but creating a \"for each in\" statement.
jTryCatchFinally :: (Ident -> JStgStat) -> (Ident -> JStgStat) -> (Ident -> JStgStat) -> JSM JStgStat
jTryCatchFinally :: (Ident -> JStgStat)
-> (Ident -> JStgStat) -> (Ident -> JStgStat) -> JSM JStgStat
jTryCatchFinally Ident -> JStgStat
c Ident -> JStgStat
f Ident -> JStgStat
f2 = do i <- StateT JEnv Identity Ident
newIdent
                             return $ TryStat (c i) i (f i) (f2 i)

-- | Convert a ShortText to a Javascript String
jString :: FastString -> JStgExpr
jString :: FastString -> JStgExpr
jString = FastString -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr

-- | construct a js declaration with the given identifier
decl :: Ident -> JStgStat
decl :: Ident -> JStgStat
decl Ident
i = Ident -> Maybe JStgExpr -> JStgStat
DeclStat Ident
i Maybe JStgExpr
forall a. Maybe a
Nothing

-- | The empty JS HashMap
jhEmpty :: M.Map k JStgExpr
jhEmpty :: forall k. Map k JStgExpr
jhEmpty = Map k JStgExpr
forall k a. Map k a
M.empty

-- | A singleton JS HashMap
jhSingle :: (Ord k, ToJExpr a) => k -> a -> M.Map k JStgExpr
jhSingle :: forall k a. (Ord k, ToJExpr a) => k -> a -> Map k JStgExpr
jhSingle k
k a
v = k -> a -> Map k JStgExpr -> Map k JStgExpr
forall k a.
(Ord k, ToJExpr a) =>
k -> a -> Map k JStgExpr -> Map k JStgExpr
jhAdd k
k a
v Map k JStgExpr
forall k. Map k JStgExpr
jhEmpty

-- | insert a key-value pair into a JS HashMap
jhAdd :: (Ord k, ToJExpr a) => k -> a -> M.Map k JStgExpr -> M.Map k JStgExpr
jhAdd :: forall k a.
(Ord k, ToJExpr a) =>
k -> a -> Map k JStgExpr -> Map k JStgExpr
jhAdd  k
k a
v Map k JStgExpr
m = k -> JStgExpr -> Map k JStgExpr -> Map k JStgExpr
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
k (a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
v) Map k JStgExpr
m

-- | Construct a JS HashMap from a list of key-value pairs
jhFromList :: [(FastString, JStgExpr)] -> JVal
jhFromList :: [(FastString, JStgExpr)] -> JVal
jhFromList = 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

-- | The empty JS statement
nullStat :: JStgStat
nullStat :: JStgStat
nullStat = [JStgStat] -> JStgStat
BlockStat []


--------------------------------------------------------------------------------
--                             Combinators
--------------------------------------------------------------------------------
-- $combinators
-- Combinators operate on terms in the JS EDSL domain to create new terms in the
-- EDSL domain.

-- | JS infix Equality operators
(.==.), (.===.), (.!=.), (.!==.) :: JStgExpr -> JStgExpr -> JStgExpr
.==. :: JStgExpr -> JStgExpr -> JStgExpr
(.==.)  = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
EqOp
.===. :: JStgExpr -> JStgExpr -> JStgExpr
(.===.) = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
StrictEqOp
.!=. :: JStgExpr -> JStgExpr -> JStgExpr
(.!=.)  = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
NeqOp
.!==. :: JStgExpr -> JStgExpr -> JStgExpr
(.!==.) = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
StrictNeqOp

infixl 6 .==., .===., .!=., .!==.

-- | JS infix Ord operators
(.>.), (.>=.), (.<.), (.<=.) :: JStgExpr -> JStgExpr -> JStgExpr
.>. :: JStgExpr -> JStgExpr -> JStgExpr
(.>.)  = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
GtOp
.>=. :: JStgExpr -> JStgExpr -> JStgExpr
(.>=.) = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
GeOp
.<. :: JStgExpr -> JStgExpr -> JStgExpr
(.<.)  = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
LtOp
.<=. :: JStgExpr -> JStgExpr -> JStgExpr
(.<=.) = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
LeOp

infixl 7 .>., .>=., .<., .<=.

-- | JS infix bit operators
(.|.), (.||.), (.&&.)  :: JStgExpr -> JStgExpr -> JStgExpr
.|. :: JStgExpr -> JStgExpr -> JStgExpr
(.|.)   = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
BOrOp
.||. :: JStgExpr -> JStgExpr -> JStgExpr
(.||.)  = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
LOrOp
.&&. :: JStgExpr -> JStgExpr -> JStgExpr
(.&&.)  = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
LAndOp

infixl 8 .||., .&&.

-- | JS infix bit shift operators
(.<<.), (.>>.), (.>>>.) :: JStgExpr -> JStgExpr -> JStgExpr
.<<. :: JStgExpr -> JStgExpr -> JStgExpr
(.<<.)  = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
LeftShiftOp
.>>. :: JStgExpr -> JStgExpr -> JStgExpr
(.>>.)  = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
RightShiftOp
.>>>. :: JStgExpr -> JStgExpr -> JStgExpr
(.>>>.) = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
ZRightShiftOp

infixl 9 .<<., .>>., .>>>.

-- | Given a 'JStgExpr', return the its type.
typeof :: JStgExpr -> JStgExpr
typeof :: JStgExpr -> JStgExpr
typeof = UOp -> JStgExpr -> JStgExpr
UOpExpr UOp
TypeofOp

-- | JS if-expression
--
-- > if_ e1 e2 e3 ==> e1 ? e2 : e3
if_ :: JStgExpr -> JStgExpr -> JStgExpr -> JStgExpr
if_ :: JStgExpr -> JStgExpr -> JStgExpr -> JStgExpr
if_ JStgExpr
e1 JStgExpr
e2 JStgExpr
e3 = JStgExpr -> JStgExpr -> JStgExpr -> JStgExpr
IfExpr JStgExpr
e1 JStgExpr
e2 JStgExpr
e3

-- | If-expression which returns statements, see related 'ifBlockS'
--
-- > if e s1 s2 ==> if(e) { s1 } else { s2 }
ifS :: JStgExpr -> JStgStat -> JStgStat -> JStgStat
ifS :: JStgExpr -> JStgStat -> JStgStat -> JStgStat
ifS JStgExpr
e JStgStat
s1 JStgStat
s2 = JStgExpr -> JStgStat -> JStgStat -> JStgStat
IfStat JStgExpr
e JStgStat
s1 JStgStat
s2


-- | Version of a JS if-expression which admits monadic actions in its branches
jIf :: JStgExpr -> JSM JStgStat -> JSM JStgStat -> JSM JStgStat
jIf :: JStgExpr -> JSM JStgStat -> JSM JStgStat -> JSM JStgStat
jIf JStgExpr
e JSM JStgStat
ma JSM JStgStat
mb = do
  !a <- JSM JStgStat
ma
  !b <- mb
  pure $ IfStat e a b

-- | A when-statement as syntactic sugar via `ifS`
--
-- > jwhenS cond block ==> if(cond) { block } else {  }
jwhenS :: JStgExpr -> JStgStat -> JStgStat
jwhenS :: JStgExpr -> JStgStat -> JStgStat
jwhenS JStgExpr
cond JStgStat
block = JStgExpr -> JStgStat -> JStgStat -> JStgStat
IfStat JStgExpr
cond JStgStat
block JStgStat
forall a. Monoid a => a
mempty

-- | If-expression which returns blocks
--
-- > ifBlockS e s1 s2 ==> if(e) { s1 } else { s2 }
ifBlockS :: JStgExpr -> [JStgStat] -> [JStgStat] -> JStgStat
ifBlockS :: JStgExpr -> [JStgStat] -> [JStgStat] -> JStgStat
ifBlockS JStgExpr
e [JStgStat]
s1 [JStgStat]
s2 = JStgExpr -> JStgStat -> JStgStat -> JStgStat
IfStat JStgExpr
e ([JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat [JStgStat]
s1) ([JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat [JStgStat]
s2)

-- | if-expression that returns 1 if condition <=> true, 0 otherwise
--
-- > if10 e ==> e ? 1 : 0
if10 :: JStgExpr -> JStgExpr
if10 :: JStgExpr -> JStgExpr
if10 JStgExpr
e = JStgExpr -> JStgExpr -> JStgExpr -> JStgExpr
IfExpr JStgExpr
e JStgExpr
one_ JStgExpr
zero_

-- | if-expression that returns 0 if condition <=> true, 1 otherwise
--
-- > if01 e ==> e ? 0 : 1
if01 :: JStgExpr -> JStgExpr
if01 :: JStgExpr -> JStgExpr
if01 JStgExpr
e = JStgExpr -> JStgExpr -> JStgExpr -> JStgExpr
IfExpr JStgExpr
e JStgExpr
zero_ JStgExpr
one_

-- | an expression application, see related 'appS'
--
-- > app f xs ==> f(xs)
app :: FastString -> [JStgExpr] -> JStgExpr
app :: FastString -> [JStgExpr] -> JStgExpr
app FastString
f [JStgExpr]
xs = JStgExpr -> [JStgExpr] -> JStgExpr
ApplExpr (FastString -> JStgExpr
var FastString
f) [JStgExpr]
xs

-- | A statement application, see the expression form 'app'
appS :: FastString -> [JStgExpr] -> JStgStat
appS :: FastString -> [JStgExpr] -> JStgStat
appS FastString
f [JStgExpr]
xs = JStgExpr -> [JStgExpr] -> JStgStat
ApplStat (FastString -> JStgExpr
var FastString
f) [JStgExpr]
xs

-- | Return a 'JStgExpr'
returnS :: JStgExpr -> JStgStat
returnS :: JStgExpr -> JStgStat
returnS JStgExpr
e = JStgExpr -> JStgStat
ReturnStat JStgExpr
e

-- | "for" loop with increment at end of body
loop :: JStgExpr -> (JStgExpr -> JStgExpr) -> (JStgExpr -> JSM JStgStat) -> JSM JStgStat
loop :: JStgExpr
-> (JStgExpr -> JStgExpr)
-> (JStgExpr -> JSM JStgStat)
-> JSM JStgStat
loop JStgExpr
initial JStgExpr -> JStgExpr
test JStgExpr -> JSM JStgStat
body_ = (JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar ((JStgExpr -> JSM JStgStat) -> JSM JStgStat)
-> (JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$ \JStgExpr
i ->
  do body <- JStgExpr -> JSM JStgStat
body_ JStgExpr
i
     return $
       mconcat [ i |= initial
               , WhileStat False (test i) body
               ]

-- | "for" loop with increment at end of body
loopBlockS :: JStgExpr -> (JStgExpr -> JStgExpr) -> (JStgExpr -> [JStgStat]) -> JSM JStgStat
loopBlockS :: JStgExpr
-> (JStgExpr -> JStgExpr)
-> (JStgExpr -> [JStgStat])
-> JSM JStgStat
loopBlockS JStgExpr
initial JStgExpr -> JStgExpr
test JStgExpr -> [JStgStat]
body = (JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar ((JStgExpr -> JSM JStgStat) -> JSM JStgStat)
-> (JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$ \JStgExpr
i ->
  JStgStat -> JSM JStgStat
forall a. a -> StateT JEnv Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$
  [JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat [ JStgExpr
i JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
initial
          , Bool -> JStgExpr -> JStgStat -> JStgStat
WhileStat Bool
False (JStgExpr -> JStgExpr
test JStgExpr
i) ([JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat (JStgExpr -> [JStgStat]
body JStgExpr
i))
          ]

-- | Prefix-increment a 'JStgExpr'
preIncrS :: JStgExpr -> JStgStat
preIncrS :: JStgExpr -> JStgStat
preIncrS JStgExpr
x = UOp -> JStgExpr -> JStgStat
UOpStat UOp
PreIncOp JStgExpr
x

-- | Postfix-increment a 'JStgExpr'
postIncrS :: JStgExpr -> JStgStat
postIncrS :: JStgExpr -> JStgStat
postIncrS JStgExpr
x = UOp -> JStgExpr -> JStgStat
UOpStat UOp
PostIncOp JStgExpr
x

-- | Prefix-decrement a 'JStgExpr'
preDecrS :: JStgExpr -> JStgStat
preDecrS :: JStgExpr -> JStgStat
preDecrS JStgExpr
x = UOp -> JStgExpr -> JStgStat
UOpStat UOp
PreDecOp JStgExpr
x

-- | Postfix-decrement a 'JStgExpr'
postDecrS :: JStgExpr -> JStgStat
postDecrS :: JStgExpr -> JStgStat
postDecrS JStgExpr
x = UOp -> JStgExpr -> JStgStat
UOpStat UOp
PostDecOp JStgExpr
x

-- | Byte indexing of o with a 64-bit offset
off64 :: JStgExpr -> JStgExpr -> JStgExpr
off64 :: JStgExpr -> JStgExpr -> JStgExpr
off64 JStgExpr
o JStgExpr
i = JStgExpr -> JStgExpr -> JStgExpr
Add JStgExpr
o (JStgExpr
i JStgExpr -> JStgExpr -> JStgExpr
.<<. JStgExpr
three_)

-- | Byte indexing of o with a 32-bit offset
off32 :: JStgExpr -> JStgExpr -> JStgExpr
off32 :: JStgExpr -> JStgExpr -> JStgExpr
off32 JStgExpr
o JStgExpr
i = JStgExpr -> JStgExpr -> JStgExpr
Add JStgExpr
o (JStgExpr
i JStgExpr -> JStgExpr -> JStgExpr
.<<. JStgExpr
two_)

-- | Byte indexing of o with a 16-bit offset
off16 :: JStgExpr -> JStgExpr -> JStgExpr
off16 :: JStgExpr -> JStgExpr -> JStgExpr
off16 JStgExpr
o JStgExpr
i = JStgExpr -> JStgExpr -> JStgExpr
Add JStgExpr
o (JStgExpr
i JStgExpr -> JStgExpr -> JStgExpr
.<<. JStgExpr
one_)

-- | Byte indexing of o with a 8-bit offset
off8 :: JStgExpr -> JStgExpr -> JStgExpr
off8 :: JStgExpr -> JStgExpr -> JStgExpr
off8 JStgExpr
o JStgExpr
i = JStgExpr -> JStgExpr -> JStgExpr
Add JStgExpr
o JStgExpr
i

-- | a bit mask to retrieve the lower 8-bits
mask8 :: JStgExpr -> JStgExpr
mask8 :: JStgExpr -> JStgExpr
mask8 JStgExpr
x = JStgExpr -> JStgExpr -> JStgExpr
BAnd JStgExpr
x (Integer -> JStgExpr
Int Integer
0xFF)

-- | a bit mask to retrieve the lower 16-bits
mask16 :: JStgExpr -> JStgExpr
mask16 :: JStgExpr -> JStgExpr
mask16 JStgExpr
x = JStgExpr -> JStgExpr -> JStgExpr
BAnd JStgExpr
x (Integer -> JStgExpr
Int Integer
0xFFFF)

-- | Sign-extend/narrow a 8-bit value
signExtend8 :: JStgExpr -> JStgExpr
signExtend8 :: JStgExpr -> JStgExpr
signExtend8 JStgExpr
x = (JStgExpr -> JStgExpr -> JStgExpr
BAnd JStgExpr
x (Integer -> JStgExpr
Int Integer
0x7F  )) JStgExpr -> JStgExpr -> JStgExpr
`Sub` (JStgExpr -> JStgExpr -> JStgExpr
BAnd JStgExpr
x (Integer -> JStgExpr
Int Integer
0x80))

-- | Sign-extend/narrow a 16-bit value
signExtend16 :: JStgExpr -> JStgExpr
signExtend16 :: JStgExpr -> JStgExpr
signExtend16 JStgExpr
x = (JStgExpr -> JStgExpr -> JStgExpr
BAnd JStgExpr
x (Integer -> JStgExpr
Int Integer
0x7FFF)) JStgExpr -> JStgExpr -> JStgExpr
`Sub` (JStgExpr -> JStgExpr -> JStgExpr
BAnd JStgExpr
x (Integer -> JStgExpr
Int Integer
0x8000))

-- | Select a property 'prop', from and object 'obj'
--
-- > obj .^ prop ==> obj.prop
(.^) :: JStgExpr -> FastString -> JStgExpr
JStgExpr
obj .^ :: JStgExpr -> FastString -> JStgExpr
.^ FastString
prop = JStgExpr -> Ident -> JStgExpr
SelExpr JStgExpr
obj (FastString -> Ident
global FastString
prop)
infixl 8 .^

-- | Assign a variable to an expression
--
-- > foo |= expr ==> var foo = expr;
(|=) :: JStgExpr -> JStgExpr -> JStgStat
|= :: JStgExpr -> JStgExpr -> JStgStat
(|=) JStgExpr
l JStgExpr
r = JStgExpr -> AOp -> JStgExpr -> JStgStat
AssignStat JStgExpr
l AOp
AssignOp JStgExpr
r

-- | Declare a variable and then Assign the variable to an expression
--
-- > foo |= expr ==> var foo; foo = expr;
(||=) :: Ident -> JStgExpr -> JStgStat
Ident
i ||= :: Ident -> JStgExpr -> JStgStat
||= JStgExpr
ex = Ident -> Maybe JStgExpr -> JStgStat
DeclStat Ident
i (JStgExpr -> Maybe JStgExpr
forall a. a -> Maybe a
Just JStgExpr
ex)

infixl 2 ||=, |=

-- | return the expression at idx of obj
--
-- > obj .! idx ==> obj[idx]
(.!) :: JStgExpr -> JStgExpr -> JStgExpr
.! :: JStgExpr -> JStgExpr -> JStgExpr
(.!) = JStgExpr -> JStgExpr -> JStgExpr
IdxExpr

infixl 8 .!

assignAllEqual :: HasDebugCallStack => [JStgExpr] -> [JStgExpr] -> JStgStat
assignAllEqual :: HasDebugCallStack => [JStgExpr] -> [JStgExpr] -> JStgStat
assignAllEqual [JStgExpr]
xs [JStgExpr]
ys = [JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat (String
-> (JStgExpr -> JStgExpr -> JStgStat)
-> [JStgExpr]
-> [JStgExpr]
-> [JStgStat]
forall a b c.
HasDebugCallStack =>
String -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithEqual String
"assignAllEqual" JStgExpr -> JStgExpr -> JStgStat
(|=) [JStgExpr]
xs [JStgExpr]
ys)

assignAll :: [JStgExpr] -> [JStgExpr] -> JStgStat
assignAll :: [JStgExpr] -> [JStgExpr] -> JStgStat
assignAll [JStgExpr]
xs [JStgExpr]
ys = [JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat ((JStgExpr -> JStgExpr -> JStgStat)
-> [JStgExpr] -> [JStgExpr] -> [JStgStat]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith JStgExpr -> JStgExpr -> JStgStat
(|=) [JStgExpr]
xs [JStgExpr]
ys)

assignAllReverseOrder :: [JStgExpr] -> [JStgExpr] -> JStgStat
assignAllReverseOrder :: [JStgExpr] -> [JStgExpr] -> JStgStat
assignAllReverseOrder [JStgExpr]
xs [JStgExpr]
ys = [JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat ([JStgStat] -> [JStgStat]
forall a. [a] -> [a]
reverse ((JStgExpr -> JStgExpr -> JStgStat)
-> [JStgExpr] -> [JStgExpr] -> [JStgStat]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith JStgExpr -> JStgExpr -> JStgStat
(|=) [JStgExpr]
xs [JStgExpr]
ys))

declAssignAll :: [Ident] -> [JStgExpr] -> JStgStat
declAssignAll :: [Ident] -> [JStgExpr] -> JStgStat
declAssignAll [Ident]
xs [JStgExpr]
ys = [JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat ((Ident -> JStgExpr -> JStgStat)
-> [Ident] -> [JStgExpr] -> [JStgStat]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Ident -> JStgExpr -> JStgStat
(||=) [Ident]
xs [JStgExpr]
ys)

trace :: ToJExpr a => a -> JStgStat
trace :: forall a. ToJExpr a => a -> JStgStat
trace a
ex = FastString -> [JStgExpr] -> JStgStat
appS FastString
"h$log" [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
ex]


--------------------------------------------------------------------------------
--                             Literals
--------------------------------------------------------------------------------
-- $literals
-- Literals in the JS EDSL are constants in the Haskell domain. These are useful
-- helper values and never change

-- | The JS literal 'null'
null_ :: JStgExpr
null_ :: JStgExpr
null_ = FastString -> JStgExpr
var FastString
"null"

-- | The JS literal 0
zero_ :: JStgExpr
zero_ :: JStgExpr
zero_ = Integer -> JStgExpr
Int Integer
0

-- | The JS literal 1
one_ :: JStgExpr
one_ :: JStgExpr
one_ = Integer -> JStgExpr
Int Integer
1

-- | The JS literal 2
two_ :: JStgExpr
two_ :: JStgExpr
two_ = Integer -> JStgExpr
Int Integer
2

-- | The JS literal 3
three_ :: JStgExpr
three_ :: JStgExpr
three_ = Integer -> JStgExpr
Int Integer
3

-- | The JS literal 'undefined'
undefined_ :: JStgExpr
undefined_ :: JStgExpr
undefined_ = FastString -> JStgExpr
var FastString
"undefined"

-- | The JS literal 'true'
true_ :: JStgExpr
true_ :: JStgExpr
true_ = JVal -> JStgExpr
ValExpr (Bool -> JVal
JBool Bool
True)

-- | The JS literal 'false'
false_ :: JStgExpr
false_ :: JStgExpr
false_ = JVal -> JStgExpr
ValExpr (Bool -> JVal
JBool Bool
False)

returnStack :: JStgStat
returnStack :: JStgStat
returnStack = JStgExpr -> JStgStat
ReturnStat (JStgExpr -> [JStgExpr] -> JStgExpr
ApplExpr (FastString -> JStgExpr
var FastString
"h$rs") [])


--------------------------------------------------------------------------------
--                             Math functions
--------------------------------------------------------------------------------
-- $math
-- Math functions in the EDSL are literals, with the exception of 'math_' which
-- is the sole math introduction function.

math :: JStgExpr
math :: JStgExpr
math = FastString -> JStgExpr
var FastString
"Math"

math_ :: FastString -> [JStgExpr] -> JStgExpr
math_ :: FastString -> [JStgExpr] -> JStgExpr
math_ FastString
op [JStgExpr]
args = JStgExpr -> [JStgExpr] -> JStgExpr
ApplExpr (JStgExpr
math JStgExpr -> FastString -> JStgExpr
.^ FastString
op) [JStgExpr]
args

math_log, math_sin, math_cos, math_tan, math_exp, math_acos, math_asin, math_atan,
  math_abs, math_pow, math_sqrt, math_asinh, math_acosh, math_atanh, math_sign,
  math_sinh, math_cosh, math_tanh, math_expm1, math_log1p, math_fround
  :: [JStgExpr] -> JStgExpr
math_log :: [JStgExpr] -> JStgExpr
math_log   = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"log"
math_sin :: [JStgExpr] -> JStgExpr
math_sin   = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"sin"
math_cos :: [JStgExpr] -> JStgExpr
math_cos   = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"cos"
math_tan :: [JStgExpr] -> JStgExpr
math_tan   = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"tan"
math_exp :: [JStgExpr] -> JStgExpr
math_exp   = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"exp"
math_acos :: [JStgExpr] -> JStgExpr
math_acos  = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"acos"
math_asin :: [JStgExpr] -> JStgExpr
math_asin  = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"asin"
math_atan :: [JStgExpr] -> JStgExpr
math_atan  = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"atan"
math_abs :: [JStgExpr] -> JStgExpr
math_abs   = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"abs"
math_pow :: [JStgExpr] -> JStgExpr
math_pow   = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"pow"
math_sign :: [JStgExpr] -> JStgExpr
math_sign  = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"sign"
math_sqrt :: [JStgExpr] -> JStgExpr
math_sqrt  = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"sqrt"
math_asinh :: [JStgExpr] -> JStgExpr
math_asinh = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"asinh"
math_acosh :: [JStgExpr] -> JStgExpr
math_acosh = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"acosh"
math_atanh :: [JStgExpr] -> JStgExpr
math_atanh = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"atanh"
math_sinh :: [JStgExpr] -> JStgExpr
math_sinh  = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"sinh"
math_cosh :: [JStgExpr] -> JStgExpr
math_cosh  = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"cosh"
math_tanh :: [JStgExpr] -> JStgExpr
math_tanh  = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"tanh"
math_expm1 :: [JStgExpr] -> JStgExpr
math_expm1 = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"expm1"
math_log1p :: [JStgExpr] -> JStgExpr
math_log1p = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"log1p"
math_fround :: [JStgExpr] -> JStgExpr
math_fround = FastString -> [JStgExpr] -> JStgExpr
math_ FastString
"fround"

instance Num JStgExpr where
    JStgExpr
x + :: JStgExpr -> JStgExpr -> JStgExpr
+ JStgExpr
y = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
AddOp JStgExpr
x JStgExpr
y
    JStgExpr
x - :: JStgExpr -> JStgExpr -> JStgExpr
- JStgExpr
y = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
SubOp JStgExpr
x JStgExpr
y
    JStgExpr
x * :: JStgExpr -> JStgExpr -> JStgExpr
* JStgExpr
y = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
MulOp JStgExpr
x JStgExpr
y
    abs :: JStgExpr -> JStgExpr
abs JStgExpr
x    = [JStgExpr] -> JStgExpr
math_abs [JStgExpr
x]
    negate :: JStgExpr -> JStgExpr
negate JStgExpr
x = UOp -> JStgExpr -> JStgExpr
UOpExpr UOp
NegOp JStgExpr
x
    signum :: JStgExpr -> JStgExpr
signum JStgExpr
x = [JStgExpr] -> JStgExpr
math_sign [JStgExpr
x]
    fromInteger :: Integer -> JStgExpr
fromInteger Integer
x = JVal -> JStgExpr
ValExpr (Integer -> JVal
JInt Integer
x)

instance Fractional JStgExpr where
    JStgExpr
x / :: JStgExpr -> JStgExpr -> JStgExpr
/ JStgExpr
y = Op -> JStgExpr -> JStgExpr -> JStgExpr
InfixExpr Op
DivOp JStgExpr
x JStgExpr
y
    fromRational :: Rational -> JStgExpr
fromRational Rational
x = JVal -> JStgExpr
ValExpr (SaneDouble -> JVal
JDouble (Rational -> SaneDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Rational
x))


-- The Solo constructor was renamed to MkSolo in ghc 9.5
#if __GLASGOW_HASKELL__ < 905
pattern MkSolo :: a -> Solo a
pattern MkSolo a = Solo a
{-# COMPLETE MkSolo #-}
#endif

--------------------------------------------------------------------------------
-- New Identifiers
--------------------------------------------------------------------------------

-- | Type class that generates fresh @a@'s for the JS backend. You should almost
-- never need to use this directly. Instead use @JSArgument@, for examples of
-- how to employ these classes please see @jVar@, @jFunction@ and call sites in
-- the Rts.
class JVarMagic a where
  fresh :: JSM a

-- | Type class that finds the form of arguments required for a JS syntax
-- object. This class gives us a single interface to generate variables for
-- functions that have different arities. Thus with it, we can have only one
-- @jFunction@ which is polymorphic over its arity, instead of 'jFunction2',
-- 'jFunction3' and so on.
class JSArgument args where
  argList :: args -> [Ident]
  args :: JSM args

instance JVarMagic Ident where
  fresh :: StateT JEnv Identity Ident
fresh = StateT JEnv Identity Ident
newIdent

instance JVarMagic JVal where
  fresh :: JSM JVal
fresh = Ident -> JVal
JVar (Ident -> JVal) -> StateT JEnv Identity Ident -> JSM JVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JEnv Identity Ident
forall a. JVarMagic a => JSM a
fresh

instance JVarMagic JStgExpr where
  fresh :: JSM JStgExpr
fresh = do i <- StateT JEnv Identity Ident
forall a. JVarMagic a => JSM a
fresh
             return $ ValExpr $ JVar i

instance (JVarMagic a, ToJExpr a) => JSArgument (Solo a) where
  argList :: Solo a -> [Ident]
argList (MkSolo a
a) = (JStgExpr -> [Ident]) -> [JStgExpr] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap JStgExpr -> [Ident]
identsE [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
a]
  args :: JSM (Solo a)
args = do i <- JSM a
forall a. JVarMagic a => JSM a
fresh
            return $ MkSolo i

instance (JVarMagic a, JVarMagic b, ToJExpr a, ToJExpr b) => JSArgument (a,b) where
  argList :: (a, b) -> [Ident]
argList (a
a,b
b) = (JStgExpr -> [Ident]) -> [JStgExpr] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap JStgExpr -> [Ident]
identsE [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
a , b -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr b
b]
  args :: JSM (a, b)
args = (,) (a -> b -> (a, b))
-> StateT JEnv Identity a -> StateT JEnv Identity (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JEnv Identity a
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (b -> (a, b))
-> StateT JEnv Identity b -> JSM (a, b)
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity b
forall a. JVarMagic a => JSM a
fresh

instance ( JVarMagic a, ToJExpr a
         , JVarMagic b, ToJExpr b
         , JVarMagic c, ToJExpr c
         ) => JSArgument (a,b,c) where
  argList :: (a, b, c) -> [Ident]
argList (a
a,b
b,c
c) = (JStgExpr -> [Ident]) -> [JStgExpr] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap JStgExpr -> [Ident]
identsE [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
a , b -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr b
b, c -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr c
c]
  args :: JSM (a, b, c)
args = (,,) (a -> b -> c -> (a, b, c))
-> StateT JEnv Identity a
-> StateT JEnv Identity (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JEnv Identity a
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (b -> c -> (a, b, c))
-> StateT JEnv Identity b -> StateT JEnv Identity (c -> (a, b, c))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity b
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (c -> (a, b, c))
-> StateT JEnv Identity c -> JSM (a, b, c)
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity c
forall a. JVarMagic a => JSM a
fresh

instance ( JVarMagic a, ToJExpr a
         , JVarMagic b, ToJExpr b
         , JVarMagic c, ToJExpr c
         , JVarMagic d, ToJExpr d
         ) => JSArgument (a,b,c,d) where
  argList :: (a, b, c, d) -> [Ident]
argList (a
a,b
b,c
c,d
d) = (JStgExpr -> [Ident]) -> [JStgExpr] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap JStgExpr -> [Ident]
identsE [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
a , b -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr b
b, c -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr c
c, d -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr d
d]
  args :: JSM (a, b, c, d)
args = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> StateT JEnv Identity a
-> StateT JEnv Identity (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JEnv Identity a
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (b -> c -> d -> (a, b, c, d))
-> StateT JEnv Identity b
-> StateT JEnv Identity (c -> d -> (a, b, c, d))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity b
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (c -> d -> (a, b, c, d))
-> StateT JEnv Identity c
-> StateT JEnv Identity (d -> (a, b, c, d))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity c
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (d -> (a, b, c, d))
-> StateT JEnv Identity d -> JSM (a, b, c, d)
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity d
forall a. JVarMagic a => JSM a
fresh

instance ( JVarMagic a, ToJExpr a
         , JVarMagic b, ToJExpr b
         , JVarMagic c, ToJExpr c
         , JVarMagic d, ToJExpr d
         , JVarMagic e, ToJExpr e
         ) => JSArgument (a,b,c,d,e) where
  argList :: (a, b, c, d, e) -> [Ident]
argList (a
a,b
b,c
c,d
d,e
e) = (JStgExpr -> [Ident]) -> [JStgExpr] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap JStgExpr -> [Ident]
identsE [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
a , b -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr b
b, c -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr c
c, d -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr d
d, e -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr e
e]
  args :: JSM (a, b, c, d, e)
args = (,,,,) (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> StateT JEnv Identity a
-> StateT JEnv Identity (b -> c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JEnv Identity a
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (b -> c -> d -> e -> (a, b, c, d, e))
-> StateT JEnv Identity b
-> StateT JEnv Identity (c -> d -> e -> (a, b, c, d, e))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity b
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (c -> d -> e -> (a, b, c, d, e))
-> StateT JEnv Identity c
-> StateT JEnv Identity (d -> e -> (a, b, c, d, e))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity c
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (d -> e -> (a, b, c, d, e))
-> StateT JEnv Identity d
-> StateT JEnv Identity (e -> (a, b, c, d, e))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity d
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (e -> (a, b, c, d, e))
-> StateT JEnv Identity e -> JSM (a, b, c, d, e)
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity e
forall a. JVarMagic a => JSM a
fresh

instance ( JVarMagic a, ToJExpr a
         , JVarMagic b, ToJExpr b
         , JVarMagic c, ToJExpr c
         , JVarMagic d, ToJExpr d
         , JVarMagic e, ToJExpr e
         , JVarMagic f, ToJExpr f
         ) => JSArgument (a,b,c,d,e,f) where
  argList :: (a, b, c, d, e, f) -> [Ident]
argList (a
a,b
b,c
c,d
d,e
e,f
f) =  (JStgExpr -> [Ident]) -> [JStgExpr] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap JStgExpr -> [Ident]
identsE [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
a , b -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr b
b, c -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr c
c, d -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr d
d, e -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr e
e, f -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr f
f]
  args :: JSM (a, b, c, d, e, f)
args = (,,,,,) (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> StateT JEnv Identity a
-> StateT
     JEnv Identity (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JEnv Identity a
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> StateT JEnv Identity b
-> StateT JEnv Identity (c -> d -> e -> f -> (a, b, c, d, e, f))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity b
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (c -> d -> e -> f -> (a, b, c, d, e, f))
-> StateT JEnv Identity c
-> StateT JEnv Identity (d -> e -> f -> (a, b, c, d, e, f))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity c
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (d -> e -> f -> (a, b, c, d, e, f))
-> StateT JEnv Identity d
-> StateT JEnv Identity (e -> f -> (a, b, c, d, e, f))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity d
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (e -> f -> (a, b, c, d, e, f))
-> StateT JEnv Identity e
-> StateT JEnv Identity (f -> (a, b, c, d, e, f))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity e
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (f -> (a, b, c, d, e, f))
-> StateT JEnv Identity f -> JSM (a, b, c, d, e, f)
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity f
forall a. JVarMagic a => JSM a
fresh

instance ( JVarMagic a, ToJExpr a
         , JVarMagic b, ToJExpr b
         , JVarMagic c, ToJExpr c
         , JVarMagic d, ToJExpr d
         , JVarMagic e, ToJExpr e
         , JVarMagic f, ToJExpr f
         , JVarMagic g, ToJExpr g
         ) => JSArgument (a,b,c,d,e,f,g) where
  argList :: (a, b, c, d, e, f, g) -> [Ident]
argList (a
a,b
b,c
c,d
d,e
e,f
f,g
g) = (JStgExpr -> [Ident]) -> [JStgExpr] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap JStgExpr -> [Ident]
identsE [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
a , b -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr b
b, c -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr c
c, d -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr d
d, e -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr e
e, f -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr f
f, g -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr g
g]
  args :: JSM (a, b, c, d, e, f, g)
args = (,,,,,,) (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> StateT JEnv Identity a
-> StateT
     JEnv Identity (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JEnv Identity a
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv Identity (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> StateT JEnv Identity b
-> StateT
     JEnv Identity (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity b
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv Identity (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> StateT JEnv Identity c
-> StateT JEnv Identity (d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity c
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> StateT JEnv Identity d
-> StateT JEnv Identity (e -> f -> g -> (a, b, c, d, e, f, g))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity d
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (e -> f -> g -> (a, b, c, d, e, f, g))
-> StateT JEnv Identity e
-> StateT JEnv Identity (f -> g -> (a, b, c, d, e, f, g))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity e
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (f -> g -> (a, b, c, d, e, f, g))
-> StateT JEnv Identity f
-> StateT JEnv Identity (g -> (a, b, c, d, e, f, g))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity f
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (g -> (a, b, c, d, e, f, g))
-> StateT JEnv Identity g -> JSM (a, b, c, d, e, f, g)
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity g
forall a. JVarMagic a => JSM a
fresh

instance ( JVarMagic a, ToJExpr a
         , JVarMagic b, ToJExpr b
         , JVarMagic c, ToJExpr c
         , JVarMagic d, ToJExpr d
         , JVarMagic e, ToJExpr e
         , JVarMagic f, ToJExpr f
         , JVarMagic g, ToJExpr g
         , JVarMagic h, ToJExpr h
         ) => JSArgument (a,b,c,d,e,f,g,h) where
  argList :: (a, b, c, d, e, f, g, h) -> [Ident]
argList (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) =  (JStgExpr -> [Ident]) -> [JStgExpr] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap JStgExpr -> [Ident]
identsE [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
a , b -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr b
b, c -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr c
c, d -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr d
d, e -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr e
e, f -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr f
f, g -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr g
g, h -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr h
h]
  args :: JSM (a, b, c, d, e, f, g, h)
args = (,,,,,,,) (a -> b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> StateT JEnv Identity a
-> StateT
     JEnv
     Identity
     (b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JEnv Identity a
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv
  Identity
  (b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> StateT JEnv Identity b
-> StateT
     JEnv
     Identity
     (c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity b
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv
  Identity
  (c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> StateT JEnv Identity c
-> StateT
     JEnv Identity (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity c
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv Identity (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> StateT JEnv Identity d
-> StateT
     JEnv Identity (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity d
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> StateT JEnv Identity e
-> StateT JEnv Identity (f -> g -> h -> (a, b, c, d, e, f, g, h))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity e
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (f -> g -> h -> (a, b, c, d, e, f, g, h))
-> StateT JEnv Identity f
-> StateT JEnv Identity (g -> h -> (a, b, c, d, e, f, g, h))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity f
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (g -> h -> (a, b, c, d, e, f, g, h))
-> StateT JEnv Identity g
-> StateT JEnv Identity (h -> (a, b, c, d, e, f, g, h))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity g
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (h -> (a, b, c, d, e, f, g, h))
-> StateT JEnv Identity h -> JSM (a, b, c, d, e, f, g, h)
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity h
forall a. JVarMagic a => JSM a
fresh

instance ( JVarMagic a, ToJExpr a
         , JVarMagic b, ToJExpr b
         , JVarMagic c, ToJExpr c
         , JVarMagic d, ToJExpr d
         , JVarMagic e, ToJExpr e
         , JVarMagic f, ToJExpr f
         , JVarMagic g, ToJExpr g
         , JVarMagic h, ToJExpr h
         , JVarMagic i, ToJExpr i
         ) => JSArgument (a,b,c,d,e,f,g,h,i) where
  argList :: (a, b, c, d, e, f, g, h, i) -> [Ident]
argList (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) = (JStgExpr -> [Ident]) -> [JStgExpr] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap JStgExpr -> [Ident]
identsE [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
a , b -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr b
b, c -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr c
c, d -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr d
d, e -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr e
e, f -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr f
f, g -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr g
g, h -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr h
h, i -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr i
i]
  args :: JSM (a, b, c, d, e, f, g, h, i)
args = (,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> (a, b, c, d, e, f, g, h, i))
-> StateT JEnv Identity a
-> StateT
     JEnv
     Identity
     (b
      -> c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JEnv Identity a
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv
  Identity
  (b
   -> c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> StateT JEnv Identity b
-> StateT
     JEnv
     Identity
     (c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity b
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv
  Identity
  (c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> StateT JEnv Identity c
-> StateT
     JEnv
     Identity
     (d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity c
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv
  Identity
  (d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> StateT JEnv Identity d
-> StateT
     JEnv
     Identity
     (e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity d
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv
  Identity
  (e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> StateT JEnv Identity e
-> StateT
     JEnv Identity (f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity e
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv Identity (f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> StateT JEnv Identity f
-> StateT
     JEnv Identity (g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity f
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> StateT JEnv Identity g
-> StateT JEnv Identity (h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity g
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (h -> i -> (a, b, c, d, e, f, g, h, i))
-> StateT JEnv Identity h
-> StateT JEnv Identity (i -> (a, b, c, d, e, f, g, h, i))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity h
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (i -> (a, b, c, d, e, f, g, h, i))
-> StateT JEnv Identity i -> JSM (a, b, c, d, e, f, g, h, i)
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity i
forall a. JVarMagic a => JSM a
fresh


instance ( JVarMagic a, ToJExpr a
         , JVarMagic b, ToJExpr b
         , JVarMagic c, ToJExpr c
         , JVarMagic d, ToJExpr d
         , JVarMagic e, ToJExpr e
         , JVarMagic f, ToJExpr f
         , JVarMagic g, ToJExpr g
         , JVarMagic h, ToJExpr h
         , JVarMagic i, ToJExpr i
         , JVarMagic j, ToJExpr j
         ) => JSArgument (a,b,c,d,e,f,g,h,i,j) where
  argList :: (a, b, c, d, e, f, g, h, i, j) -> [Ident]
argList (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j) =  (JStgExpr -> [Ident]) -> [JStgExpr] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap JStgExpr -> [Ident]
identsE [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
a , b -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr b
b, c -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr c
c, d -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr d
d, e -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr e
e, f -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr f
f, g -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr g
g, h -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr h
h, i -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr i
i, j -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr j
j]
  args :: JSM (a, b, c, d, e, f, g, h, i, j)
args = (,,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> (a, b, c, d, e, f, g, h, i, j))
-> StateT JEnv Identity a
-> StateT
     JEnv
     Identity
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JEnv Identity a
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv
  Identity
  (b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> (a, b, c, d, e, f, g, h, i, j))
-> StateT JEnv Identity b
-> StateT
     JEnv
     Identity
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> (a, b, c, d, e, f, g, h, i, j))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity b
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv
  Identity
  (c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> (a, b, c, d, e, f, g, h, i, j))
-> StateT JEnv Identity c
-> StateT
     JEnv
     Identity
     (d -> e -> f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity c
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv
  Identity
  (d -> e -> f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> StateT JEnv Identity d
-> StateT
     JEnv
     Identity
     (e -> f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity d
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv
  Identity
  (e -> f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> StateT JEnv Identity e
-> StateT
     JEnv
     Identity
     (f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity e
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv
  Identity
  (f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> StateT JEnv Identity f
-> StateT
     JEnv Identity (g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity f
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv Identity (g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> StateT JEnv Identity g
-> StateT
     JEnv Identity (h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity g
forall a. JVarMagic a => JSM a
fresh StateT
  JEnv Identity (h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> StateT JEnv Identity h
-> StateT JEnv Identity (i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity h
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> StateT JEnv Identity i
-> StateT JEnv Identity (j -> (a, b, c, d, e, f, g, h, i, j))
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity i
forall a. JVarMagic a => JSM a
fresh StateT JEnv Identity (j -> (a, b, c, d, e, f, g, h, i, j))
-> StateT JEnv Identity j -> JSM (a, b, c, d, e, f, g, h, i, j)
forall a b.
StateT JEnv Identity (a -> b)
-> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT JEnv Identity j
forall a. JVarMagic a => JSM a
fresh