{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}

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

-----------------------------------------------------------------------------
-- |
-- 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.UnitUtils' and 'GHC.StgToJS.CoreUtils' for such functions.
--
--      * /Introduction/ functions
--
--           We define various primitive helpers which /introduce/ terms in the
--           EDSL, for example 'jVar', 'jLam', and 'var' and 'jString'. Notice
--           that the type of each of these functions have the domain @isSat a
--           => a -> ...@; indicating that they each take something that /can/
--           be injected into the EDSL domain, and the range 'JExpr' or 'JStat';
--           indicating the corresponding value in the EDSL domain. Similarly
--           this module exports two typeclasses 'ToExpr' and 'ToSat', 'ToExpr'
--           injects values as a JS expression into the EDSL. 'ToSat' ensures
--           that terms introduced into the EDSL carry identifier information so
--           terms in the EDSL must have meaning.
--
--      * /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.
-----------------------------------------------------------------------------
module GHC.JS.Make
  ( -- * Injection Type classes
    -- $classes
    ToJExpr(..)
  , ToStat(..)
  -- * Introduction functions
  -- $intro_funcs
  , var
  , jString
  , jLam, jVar, jFor, jForIn, jForEachIn, jTryCatchFinally
  -- * Combinators
  -- $combinators
  , (||=), (|=), (.==.), (.===.), (.!=.), (.!==.), (.!)
  , (.>.), (.>=.), (.<.), (.<=.)
  , (.<<.), (.>>.), (.>>>.)
  , (.|.), (.||.), (.&&.)
  , if_, if10, if01, ifS, ifBlockS
  , 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
  , decl
  -- * Miscellaneous
  -- $misc
  , allocData, allocClsA
  , dataFieldName, dataFieldNames
  )
where

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

import GHC.JS.Syntax

import Control.Arrow ((***))

import Data.Array
import qualified Data.Map as M
import qualified Data.List as List

import GHC.Utils.Outputable (Outputable (..))
import GHC.Data.FastString
import GHC.Utils.Monad.State.Strict
import GHC.Utils.Panic
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   -> JExpr
    toJExprFromList :: [a] -> JExpr
    toJExprFromList = JVal -> JExpr
ValExpr (JVal -> JExpr) -> ([a] -> JVal) -> [a] -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList ([JExpr] -> JVal) -> ([a] -> [JExpr]) -> [a] -> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> JExpr) -> [a] -> [JExpr]
forall a b. (a -> b) -> [a] -> [b]
map a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr

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

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

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

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

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

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

instance ToJExpr a => ToJExpr (M.Map String a) where
    toJExpr :: Map String a -> JExpr
toJExpr = JVal -> JExpr
ValExpr (JVal -> JExpr) -> (Map String a -> JVal) -> Map String a -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqMap FastString JExpr -> JVal
JHash (UniqMap FastString JExpr -> JVal)
-> (Map String a -> UniqMap FastString JExpr)
-> Map String a
-> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FastString, JExpr)] -> UniqMap FastString JExpr
forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap ([(FastString, JExpr)] -> UniqMap FastString JExpr)
-> (Map String a -> [(FastString, JExpr)])
-> Map String a
-> UniqMap FastString JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, a) -> (FastString, JExpr))
-> [(String, a)] -> [(FastString, JExpr)]
forall a b. (a -> b) -> [a] -> [b]
map (String -> FastString
mkFastString (String -> FastString)
-> (a -> JExpr) -> (String, a) -> (FastString, JExpr)
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 -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr) ([(String, a)] -> [(FastString, JExpr)])
-> (Map String a -> [(String, a)])
-> Map String a
-> [(FastString, JExpr)]
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 -> JExpr
toJExpr = JVal -> JExpr
ValExpr (JVal -> JExpr) -> (Double -> JVal) -> Double -> JExpr
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 -> JExpr
toJExpr = JVal -> JExpr
ValExpr (JVal -> JExpr) -> (Int -> JVal) -> Int -> JExpr
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 -> JExpr
toJExpr = JVal -> JExpr
ValExpr (JVal -> JExpr) -> (Integer -> JVal) -> Integer -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> JVal
JInt

instance ToJExpr Char where
    toJExpr :: Char -> JExpr
toJExpr = JVal -> JExpr
ValExpr (JVal -> JExpr) -> (Char -> JVal) -> Char -> JExpr
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 -> JExpr
toJExprFromList = JVal -> JExpr
ValExpr (JVal -> JExpr) -> (String -> JVal) -> String -> JExpr
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 -> JExpr
toJExpr = JVal -> JExpr
ValExpr (JVal -> JExpr) -> (Ident -> JVal) -> Ident -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> JVal
JVar

instance ToJExpr FastString where
    toJExpr :: FastString -> JExpr
toJExpr = JVal -> JExpr
ValExpr (JVal -> JExpr) -> (FastString -> JVal) -> FastString -> JExpr
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) -> JExpr
toJExpr (a
a,b
b) = JVal -> JExpr
ValExpr (JVal -> JExpr) -> ([JExpr] -> JVal) -> [JExpr] -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList ([JExpr] -> JExpr) -> [JExpr] -> JExpr
forall a b. (a -> b) -> a -> b
$ [a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr a
a, b -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr b
b]

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

instance (ToJExpr a, ToJExpr b, ToJExpr c, ToJExpr d) => ToJExpr (a,b,c,d) where
    toJExpr :: (a, b, c, d) -> JExpr
toJExpr (a
a,b
b,c
c,d
d) = JVal -> JExpr
ValExpr (JVal -> JExpr) -> ([JExpr] -> JVal) -> [JExpr] -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList ([JExpr] -> JExpr) -> [JExpr] -> JExpr
forall a b. (a -> b) -> a -> b
$ [a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr a
a, b -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr b
b, c -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr c
c, d -> JExpr
forall a. ToJExpr a => a -> JExpr
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) -> JExpr
toJExpr (a
a,b
b,c
c,d
d,e
e) = JVal -> JExpr
ValExpr (JVal -> JExpr) -> ([JExpr] -> JVal) -> [JExpr] -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList ([JExpr] -> JExpr) -> [JExpr] -> JExpr
forall a b. (a -> b) -> a -> b
$ [a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr a
a, b -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr b
b, c -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr c
c, d -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr d
d, e -> JExpr
forall a. ToJExpr a => a -> JExpr
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) -> JExpr
toJExpr (a
a,b
b,c
c,d
d,e
e,f
f) = JVal -> JExpr
ValExpr (JVal -> JExpr) -> ([JExpr] -> JVal) -> [JExpr] -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList ([JExpr] -> JExpr) -> [JExpr] -> JExpr
forall a b. (a -> b) -> a -> b
$ [a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr a
a, b -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr b
b, c -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr c
c, d -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr d
d, e -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr e
e, f -> JExpr
forall a. ToJExpr a => a -> JExpr
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 -> JStat

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

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

instance ToStat JExpr where
    toStat :: JExpr -> JStat
toStat = JExpr -> JStat
expr2stat

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

--------------------------------------------------------------------------------
--                        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 :: ToSat a => a -> JExpr
jLam :: forall a. ToSat a => a -> JExpr
jLam a
f = JVal -> JExpr
ValExpr (JVal -> JExpr)
-> (State [Ident] JVal -> JVal) -> State [Ident] JVal -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentSupply JVal -> JVal
UnsatVal (IdentSupply JVal -> JVal)
-> (State [Ident] JVal -> IdentSupply JVal)
-> State [Ident] JVal
-> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State [Ident] JVal -> IdentSupply JVal
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] JVal -> JExpr) -> State [Ident] JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ do
           (JStat
block,[Ident]
is) <- IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. IdentSupply a -> State [Ident] a
runIdentSupply (IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ a -> [Ident] -> IdentSupply (JStat, [Ident])
forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ a
f []
           JVal -> State [Ident] JVal
forall a. a -> State [Ident] a
forall (m :: * -> *) a. Monad m => a -> m a
return (JVal -> State [Ident] JVal) -> JVal -> State [Ident] JVal
forall a b. (a -> b) -> a -> b
$ [Ident] -> JStat -> JVal
JFunc [Ident]
is JStat
block

-- | Introduce a new variable into scope for the duration
-- of the enclosed expression. The result is a block statement.
-- Usage:
--
-- @jVar $ \x y -> mconcat [jVar x ||= one_, jVar y ||= two_, jVar x + jVar y]@
jVar :: ToSat a => a -> JStat
jVar :: forall a. ToSat a => a -> JStat
jVar a
f = IdentSupply JStat -> JStat
UnsatBlock (IdentSupply JStat -> JStat)
-> (State [Ident] JStat -> IdentSupply JStat)
-> State [Ident] JStat
-> JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State [Ident] JStat -> IdentSupply JStat
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] JStat -> JStat) -> State [Ident] JStat -> JStat
forall a b. (a -> b) -> a -> b
$ do
           (JStat
block, [Ident]
is) <- IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. IdentSupply a -> State [Ident] a
runIdentSupply (IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ a -> [Ident] -> IdentSupply (JStat, [Ident])
forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ a
f []
           let addDecls :: JStat -> JStat
addDecls (BlockStat [JStat]
ss) =
                  [JStat] -> JStat
BlockStat ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$ (Ident -> JStat) -> [Ident] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> JStat
decl [Ident]
is [JStat] -> [JStat] -> [JStat]
forall a. [a] -> [a] -> [a]
++ [JStat]
ss
               addDecls JStat
x = JStat
x
           JStat -> State [Ident] JStat
forall a. a -> State [Ident] a
forall (m :: * -> *) a. Monad m => a -> m a
return (JStat -> State [Ident] JStat) -> JStat -> State [Ident] JStat
forall a b. (a -> b) -> a -> b
$ JStat -> JStat
addDecls JStat
block

-- | Create a 'for in' statement.
-- Usage:
--
-- @jForIn {expression} $ \x -> {block involving x}@
jForIn :: ToSat a => JExpr -> (JExpr -> a)  -> JStat
jForIn :: forall a. ToSat a => JExpr -> (JExpr -> a) -> JStat
jForIn JExpr
e JExpr -> a
f = IdentSupply JStat -> JStat
UnsatBlock (IdentSupply JStat -> JStat)
-> (State [Ident] JStat -> IdentSupply JStat)
-> State [Ident] JStat
-> JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State [Ident] JStat -> IdentSupply JStat
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] JStat -> JStat) -> State [Ident] JStat -> JStat
forall a b. (a -> b) -> a -> b
$ do
               (JStat
block, [Ident]
is) <- IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. IdentSupply a -> State [Ident] a
runIdentSupply (IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ (JExpr -> a) -> [Ident] -> IdentSupply (JStat, [Ident])
forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ JExpr -> a
f []
               let i :: Ident
i = [Ident] -> Ident
forall a. HasCallStack => [a] -> a
List.head [Ident]
is
               JStat -> State [Ident] JStat
forall a. a -> State [Ident] a
forall (m :: * -> *) a. Monad m => a -> m a
return (JStat -> State [Ident] JStat) -> JStat -> State [Ident] JStat
forall a b. (a -> b) -> a -> b
$ Ident -> JStat
decl Ident
i JStat -> JStat -> JStat
forall a. Monoid a => a -> a -> a
`mappend` Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
False Ident
i JExpr
e JStat
block

-- | As with "jForIn" but creating a \"for each in\" statement.
jForEachIn :: ToSat a => JExpr -> (JExpr -> a) -> JStat
jForEachIn :: forall a. ToSat a => JExpr -> (JExpr -> a) -> JStat
jForEachIn JExpr
e JExpr -> a
f = IdentSupply JStat -> JStat
UnsatBlock (IdentSupply JStat -> JStat)
-> (State [Ident] JStat -> IdentSupply JStat)
-> State [Ident] JStat
-> JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State [Ident] JStat -> IdentSupply JStat
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] JStat -> JStat) -> State [Ident] JStat -> JStat
forall a b. (a -> b) -> a -> b
$ do
               (JStat
block, [Ident]
is) <- IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. IdentSupply a -> State [Ident] a
runIdentSupply (IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ (JExpr -> a) -> [Ident] -> IdentSupply (JStat, [Ident])
forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ JExpr -> a
f []
               let i :: Ident
i = [Ident] -> Ident
forall a. HasCallStack => [a] -> a
List.head [Ident]
is
               JStat -> State [Ident] JStat
forall a. a -> State [Ident] a
forall (m :: * -> *) a. Monad m => a -> m a
return (JStat -> State [Ident] JStat) -> JStat -> State [Ident] JStat
forall a b. (a -> b) -> a -> b
$ Ident -> JStat
decl Ident
i JStat -> JStat -> JStat
forall a. Monoid a => a -> a -> a
`mappend` Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
True Ident
i JExpr
e JStat
block

-- | As with "jForIn" but creating a \"for each in\" statement.
jTryCatchFinally :: (ToSat a) => JStat -> a -> JStat -> JStat
jTryCatchFinally :: forall a. ToSat a => JStat -> a -> JStat -> JStat
jTryCatchFinally JStat
s a
f JStat
s2 = IdentSupply JStat -> JStat
UnsatBlock (IdentSupply JStat -> JStat)
-> (State [Ident] JStat -> IdentSupply JStat)
-> State [Ident] JStat
-> JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State [Ident] JStat -> IdentSupply JStat
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] JStat -> JStat) -> State [Ident] JStat -> JStat
forall a b. (a -> b) -> a -> b
$ do
                     (JStat
block, [Ident]
is) <- IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. IdentSupply a -> State [Ident] a
runIdentSupply (IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ a -> [Ident] -> IdentSupply (JStat, [Ident])
forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ a
f []
                     let i :: Ident
i = [Ident] -> Ident
forall a. HasCallStack => [a] -> a
List.head [Ident]
is
                     JStat -> State [Ident] JStat
forall a. a -> State [Ident] a
forall (m :: * -> *) a. Monad m => a -> m a
return (JStat -> State [Ident] JStat) -> JStat -> State [Ident] JStat
forall a b. (a -> b) -> a -> b
$ JStat -> Ident -> JStat -> JStat -> JStat
TryStat JStat
s Ident
i JStat
block JStat
s2

-- | construct a JS variable reference
var :: FastString -> JExpr
var :: FastString -> JExpr
var = JVal -> JExpr
ValExpr (JVal -> JExpr) -> (FastString -> JVal) -> FastString -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> JVal
JVar (Ident -> JVal) -> (FastString -> Ident) -> FastString -> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> Ident
TxtI

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

-- | Create a 'for' statement
jFor :: (ToJExpr a, ToStat b) => JStat -> a -> JStat -> b -> JStat
jFor :: forall a b.
(ToJExpr a, ToStat b) =>
JStat -> a -> JStat -> b -> JStat
jFor JStat
before a
p JStat
after b
b = [JStat] -> JStat
BlockStat [JStat
before, Bool -> JExpr -> JStat -> JStat
WhileStat Bool
False (a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr a
p) JStat
b']
    where b' :: JStat
b' = case b -> JStat
forall a. ToStat a => a -> JStat
toStat b
b of
                 BlockStat [JStat]
xs -> [JStat] -> JStat
BlockStat ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$ [JStat]
xs [JStat] -> [JStat] -> [JStat]
forall a. [a] -> [a] -> [a]
++ [JStat
after]
                 JStat
x -> [JStat] -> JStat
BlockStat [JStat
x,JStat
after]

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

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

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

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

-- | Construct a JS HashMap from a list of key-value pairs
jhFromList :: [(FastString, JExpr)] -> JVal
jhFromList :: [(FastString, JExpr)] -> JVal
jhFromList = UniqMap FastString JExpr -> JVal
JHash (UniqMap FastString JExpr -> JVal)
-> ([(FastString, JExpr)] -> UniqMap FastString JExpr)
-> [(FastString, JExpr)]
-> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FastString, JExpr)] -> UniqMap FastString JExpr
forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap

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


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

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

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

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

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

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

infixl 8 .||., .&&.

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

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

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

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

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

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

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

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

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

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

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

-- | Return a 'JExpr'
returnS :: JExpr -> JStat
returnS :: JExpr -> JStat
returnS JExpr
e = JExpr -> JStat
ReturnStat JExpr
e

-- | "for" loop with increment at end of body
loop :: JExpr -> (JExpr -> JExpr) -> (JExpr -> JStat) -> JStat
loop :: JExpr -> (JExpr -> JExpr) -> (JExpr -> JStat) -> JStat
loop JExpr
initial JExpr -> JExpr
test JExpr -> JStat
body = (JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JStat) -> JStat) -> (JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
i ->
  [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr
i JExpr -> JExpr -> JStat
|= JExpr
initial
          , Bool -> JExpr -> JStat -> JStat
WhileStat Bool
False (JExpr -> JExpr
test JExpr
i) (JExpr -> JStat
body JExpr
i)
          ]

-- | "for" loop with increment at end of body
loopBlockS :: JExpr -> (JExpr -> JExpr) -> (JExpr -> [JStat]) -> JStat
loopBlockS :: JExpr -> (JExpr -> JExpr) -> (JExpr -> [JStat]) -> JStat
loopBlockS JExpr
initial JExpr -> JExpr
test JExpr -> [JStat]
body = (JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JStat) -> JStat) -> (JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
i ->
  [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr
i JExpr -> JExpr -> JStat
|= JExpr
initial
          , Bool -> JExpr -> JStat -> JStat
WhileStat Bool
False (JExpr -> JExpr
test JExpr
i) ([JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat (JExpr -> [JStat]
body JExpr
i))
          ]

-- | Prefix-increment a 'JExpr'
preIncrS :: JExpr -> JStat
preIncrS :: JExpr -> JStat
preIncrS JExpr
x = JUOp -> JExpr -> JStat
UOpStat JUOp
PreIncOp JExpr
x

-- | Postfix-increment a 'JExpr'
postIncrS :: JExpr -> JStat
postIncrS :: JExpr -> JStat
postIncrS JExpr
x = JUOp -> JExpr -> JStat
UOpStat JUOp
PostIncOp JExpr
x

-- | Prefix-decrement a 'JExpr'
preDecrS :: JExpr -> JStat
preDecrS :: JExpr -> JStat
preDecrS JExpr
x = JUOp -> JExpr -> JStat
UOpStat JUOp
PreDecOp JExpr
x

-- | Postfix-decrement a 'JExpr'
postDecrS :: JExpr -> JStat
postDecrS :: JExpr -> JStat
postDecrS JExpr
x = JUOp -> JExpr -> JStat
UOpStat JUOp
PostDecOp JExpr
x

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

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

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

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

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

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

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

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

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

-- | Assign a variable to an expression
--
-- > foo |= expr ==> var foo = expr;
(|=) :: JExpr -> JExpr -> JStat
|= :: JExpr -> JExpr -> JStat
(|=) = JExpr -> JExpr -> JStat
AssignStat

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

infixl 2 ||=, |=

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

infixl 8 .!

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

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

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

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

trace :: ToJExpr a => a -> JStat
trace :: forall a. ToJExpr a => a -> JStat
trace a
ex = FastString -> [JExpr] -> JStat
appS FastString
"h$log" [a -> JExpr
forall a. ToJExpr a => a -> JExpr
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_ :: JExpr
null_ :: JExpr
null_ = FastString -> JExpr
var FastString
"null"

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

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

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

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

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

-- | The JS literal 'true'
true_ :: JExpr
true_ :: JExpr
true_ = FastString -> JExpr
var FastString
"true"

-- | The JS literal 'false'
false_ :: JExpr
false_ :: JExpr
false_ = FastString -> JExpr
var FastString
"false"

returnStack :: JStat
returnStack :: JStat
returnStack = JExpr -> JStat
ReturnStat (JExpr -> [JExpr] -> JExpr
ApplExpr (FastString -> JExpr
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 :: JExpr
math :: JExpr
math = FastString -> JExpr
var FastString
"Math"

math_ :: FastString -> [JExpr] -> JExpr
math_ :: FastString -> [JExpr] -> JExpr
math_ FastString
op [JExpr]
args = JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr
math JExpr -> FastString -> JExpr
.^ FastString
op) [JExpr]
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
  :: [JExpr] -> JExpr
math_log :: [JExpr] -> JExpr
math_log   = FastString -> [JExpr] -> JExpr
math_ FastString
"log"
math_sin :: [JExpr] -> JExpr
math_sin   = FastString -> [JExpr] -> JExpr
math_ FastString
"sin"
math_cos :: [JExpr] -> JExpr
math_cos   = FastString -> [JExpr] -> JExpr
math_ FastString
"cos"
math_tan :: [JExpr] -> JExpr
math_tan   = FastString -> [JExpr] -> JExpr
math_ FastString
"tan"
math_exp :: [JExpr] -> JExpr
math_exp   = FastString -> [JExpr] -> JExpr
math_ FastString
"exp"
math_acos :: [JExpr] -> JExpr
math_acos  = FastString -> [JExpr] -> JExpr
math_ FastString
"acos"
math_asin :: [JExpr] -> JExpr
math_asin  = FastString -> [JExpr] -> JExpr
math_ FastString
"asin"
math_atan :: [JExpr] -> JExpr
math_atan  = FastString -> [JExpr] -> JExpr
math_ FastString
"atan"
math_abs :: [JExpr] -> JExpr
math_abs   = FastString -> [JExpr] -> JExpr
math_ FastString
"abs"
math_pow :: [JExpr] -> JExpr
math_pow   = FastString -> [JExpr] -> JExpr
math_ FastString
"pow"
math_sign :: [JExpr] -> JExpr
math_sign  = FastString -> [JExpr] -> JExpr
math_ FastString
"sign"
math_sqrt :: [JExpr] -> JExpr
math_sqrt  = FastString -> [JExpr] -> JExpr
math_ FastString
"sqrt"
math_asinh :: [JExpr] -> JExpr
math_asinh = FastString -> [JExpr] -> JExpr
math_ FastString
"asinh"
math_acosh :: [JExpr] -> JExpr
math_acosh = FastString -> [JExpr] -> JExpr
math_ FastString
"acosh"
math_atanh :: [JExpr] -> JExpr
math_atanh = FastString -> [JExpr] -> JExpr
math_ FastString
"atanh"
math_sinh :: [JExpr] -> JExpr
math_sinh  = FastString -> [JExpr] -> JExpr
math_ FastString
"sinh"
math_cosh :: [JExpr] -> JExpr
math_cosh  = FastString -> [JExpr] -> JExpr
math_ FastString
"cosh"
math_tanh :: [JExpr] -> JExpr
math_tanh  = FastString -> [JExpr] -> JExpr
math_ FastString
"tanh"
math_expm1 :: [JExpr] -> JExpr
math_expm1 = FastString -> [JExpr] -> JExpr
math_ FastString
"expm1"
math_log1p :: [JExpr] -> JExpr
math_log1p = FastString -> [JExpr] -> JExpr
math_ FastString
"log1p"
math_fround :: [JExpr] -> JExpr
math_fround = FastString -> [JExpr] -> JExpr
math_ FastString
"fround"

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

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


--------------------------------------------------------------------------------
--                             Miscellaneous
--------------------------------------------------------------------------------
-- $misc
-- Everything else,

-- | 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]
map (String -> FastString
mkFastString (String -> FastString) -> (Int -> String) -> Int -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'd'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [(Int
0::Int)..Int
nFieldCache])

nFieldCache :: Int
nFieldCache :: Int
nFieldCache  = Int
16384

dataFieldName :: Int -> FastString
dataFieldName :: Int -> FastString
dataFieldName Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
nFieldCache = String -> SDoc -> FastString
forall a. HasCallStack => String -> a
panic String
"dataFieldName" (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr 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

dataFieldNames :: [FastString]
dataFieldNames :: [FastString]
dataFieldNames = (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..Int
nFieldCache]


-- | 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
1024) ((Int -> FastString) -> [Int] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map (String -> FastString
mkFastString (String -> FastString) -> (Int -> String) -> Int -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"h$d"String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [(Int
0::Int)..Int
1024])

allocData :: Int -> JExpr
allocData :: Int -> JExpr
allocData Int
i = Ident -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (FastString -> Ident
TxtI (Array Int FastString
dataCache Array Int FastString -> Int -> FastString
forall i e. Ix i => Array i e -> i -> e
! 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
1024) ((Int -> FastString) -> [Int] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map (String -> FastString
mkFastString (String -> FastString) -> (Int -> String) -> Int -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"h$c"String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [(Int
0::Int)..Int
1024])

allocClsA :: Int -> JExpr
allocClsA :: Int -> JExpr
allocClsA Int
i = Ident -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (FastString -> Ident
TxtI (Array Int FastString
clsCache Array Int FastString -> Int -> FastString
forall i e. Ix i => Array i e -> i -> e
! Int
i))


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

-- | The 'ToSat' class is heavily used in the Introduction function. It ensures
-- that all identifiers in the EDSL are tracked and named with an 'IdentSupply'.
class ToSat a where
    toSat_ :: a -> [Ident] -> IdentSupply (JStat, [Ident])

instance ToSat [JStat] where
    toSat_ :: [JStat] -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ [JStat]
f [Ident]
vs = State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident]))
-> State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. a -> State [Ident] a
forall (m :: * -> *) a. Monad m => a -> m a
return ((JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ ([JStat] -> JStat
BlockStat [JStat]
f, [Ident] -> [Ident]
forall a. [a] -> [a]
reverse [Ident]
vs)

instance ToSat JStat where
    toSat_ :: JStat -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ JStat
f [Ident]
vs = State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident]))
-> State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. a -> State [Ident] a
forall (m :: * -> *) a. Monad m => a -> m a
return ((JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ (JStat
f, [Ident] -> [Ident]
forall a. [a] -> [a]
reverse [Ident]
vs)

instance ToSat JExpr where
    toSat_ :: JExpr -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ JExpr
f [Ident]
vs = State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident]))
-> State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. a -> State [Ident] a
forall (m :: * -> *) a. Monad m => a -> m a
return ((JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ (JExpr -> JStat
forall a. ToStat a => a -> JStat
toStat JExpr
f, [Ident] -> [Ident]
forall a. [a] -> [a]
reverse [Ident]
vs)

instance ToSat [JExpr] where
    toSat_ :: [JExpr] -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ [JExpr]
f [Ident]
vs = State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident]))
-> State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. a -> State [Ident] a
forall (m :: * -> *) a. Monad m => a -> m a
return ((JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ ([JStat] -> JStat
BlockStat ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$ (JExpr -> JStat) -> [JExpr] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map JExpr -> JStat
expr2stat [JExpr]
f, [Ident] -> [Ident]
forall a. [a] -> [a]
reverse [Ident]
vs)

instance (ToSat a, b ~ JExpr) => ToSat (b -> a) where
    toSat_ :: (b -> a) -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ b -> a
f [Ident]
vs = State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident]))
-> State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ do
      Ident
x <- State [Ident] Ident
takeOneIdent
      IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. IdentSupply a -> State [Ident] a
runIdentSupply (IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ a -> [Ident] -> IdentSupply (JStat, [Ident])
forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ (b -> a
f (JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar Ident
x)) (Ident
xIdent -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
:[Ident]
vs)

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

takeOneIdent :: State [Ident] Ident
takeOneIdent :: State [Ident] Ident
takeOneIdent = do
  [Ident]
xxs <- State [Ident] [Ident]
forall s. State s s
get
  case [Ident]
xxs of
    (Ident
x:[Ident]
xs) -> do
      [Ident] -> State [Ident] ()
forall s. s -> State s ()
put [Ident]
xs
      Ident -> State [Ident] Ident
forall a. a -> State [Ident] a
forall (m :: * -> *) a. Monad m => a -> m a
return Ident
x
    [Ident]
_ -> String -> State [Ident] Ident
forall a. HasCallStack => String -> a
error String
"takeOneIdent: empty list"