{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE BlockArguments #-}
module GHC.JS.Transform
( mapIdent
, mapStatIdent
, mapExprIdent
, identsS
, identsV
, identsE
, jsSaturate
, JMacro(..)
, JMGadt(..)
, Compos(..)
, composOp
, composOpM
, composOpM_
, composOpFold
)
where
import GHC.Prelude
import GHC.JS.Syntax
import Data.Functor.Identity
import Control.Monad
import Data.Bifunctor
import GHC.Data.FastString
import GHC.Utils.Monad.State.Strict
import GHC.Types.Unique.Map
mapExprIdent :: (Ident -> JExpr) -> JExpr -> JExpr
mapExprIdent :: (Ident -> JExpr) -> JExpr -> JExpr
mapExprIdent Ident -> JExpr
f = forall a b. (a, b) -> a
fst ((Ident -> JExpr) -> (JExpr -> JExpr, JStat -> JStat)
mapIdent Ident -> JExpr
f)
mapStatIdent :: (Ident -> JExpr) -> JStat -> JStat
mapStatIdent :: (Ident -> JExpr) -> JStat -> JStat
mapStatIdent Ident -> JExpr
f = forall a b. (a, b) -> b
snd ((Ident -> JExpr) -> (JExpr -> JExpr, JStat -> JStat)
mapIdent Ident -> JExpr
f)
mapIdent :: (Ident -> JExpr) -> (JExpr -> JExpr, JStat -> JStat)
mapIdent :: (Ident -> JExpr) -> (JExpr -> JExpr, JStat -> JStat)
mapIdent Ident -> JExpr
f = (JExpr -> JExpr
map_expr, JStat -> JStat
map_stat)
where
map_expr :: JExpr -> JExpr
map_expr = \case
ValExpr JVal
v -> JVal -> JExpr
map_val JVal
v
SelExpr JExpr
e Ident
i -> JExpr -> Ident -> JExpr
SelExpr (JExpr -> JExpr
map_expr JExpr
e) Ident
i
IdxExpr JExpr
e1 JExpr
e2 -> JExpr -> JExpr -> JExpr
IdxExpr (JExpr -> JExpr
map_expr JExpr
e1) (JExpr -> JExpr
map_expr JExpr
e2)
InfixExpr JOp
o JExpr
e1 JExpr
e2 -> JOp -> JExpr -> JExpr -> JExpr
InfixExpr JOp
o (JExpr -> JExpr
map_expr JExpr
e1) (JExpr -> JExpr
map_expr JExpr
e2)
UOpExpr JUOp
o JExpr
e -> JUOp -> JExpr -> JExpr
UOpExpr JUOp
o (JExpr -> JExpr
map_expr JExpr
e)
IfExpr JExpr
e1 JExpr
e2 JExpr
e3 -> JExpr -> JExpr -> JExpr -> JExpr
IfExpr (JExpr -> JExpr
map_expr JExpr
e1) (JExpr -> JExpr
map_expr JExpr
e2) (JExpr -> JExpr
map_expr JExpr
e3)
ApplExpr JExpr
e [JExpr]
es -> JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr -> JExpr
map_expr JExpr
e) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JExpr -> JExpr
map_expr [JExpr]
es)
UnsatExpr IdentSupply JExpr
me -> IdentSupply JExpr -> JExpr
UnsatExpr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JExpr -> JExpr
map_expr IdentSupply JExpr
me)
map_val :: JVal -> JExpr
map_val JVal
v = case JVal
v of
JVar Ident
i -> Ident -> JExpr
f Ident
i
JList [JExpr]
es -> JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ [JExpr] -> JVal
JList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JExpr -> JExpr
map_expr [JExpr]
es)
JDouble{} -> JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ JVal
v
JInt{} -> JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ JVal
v
JStr{} -> JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ JVal
v
JRegEx{} -> JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ JVal
v
JHash UniqMap FastString JExpr
me -> JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ UniqMap FastString JExpr -> JVal
JHash (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JExpr -> JExpr
map_expr UniqMap FastString JExpr
me)
JFunc [Ident]
is JStat
s -> JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ [Ident] -> JStat -> JVal
JFunc [Ident]
is (JStat -> JStat
map_stat JStat
s)
UnsatVal IdentSupply JVal
v2 -> JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ IdentSupply JVal -> JVal
UnsatVal IdentSupply JVal
v2
map_stat :: JStat -> JStat
map_stat JStat
s = case JStat
s of
DeclStat Ident
i Maybe JExpr
e -> Ident -> Maybe JExpr -> JStat
DeclStat Ident
i (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JExpr -> JExpr
map_expr Maybe JExpr
e)
ReturnStat JExpr
e -> JExpr -> JStat
ReturnStat (JExpr -> JExpr
map_expr JExpr
e)
IfStat JExpr
e JStat
s1 JStat
s2 -> JExpr -> JStat -> JStat -> JStat
IfStat (JExpr -> JExpr
map_expr JExpr
e) (JStat -> JStat
map_stat JStat
s1) (JStat -> JStat
map_stat JStat
s2)
WhileStat Bool
b JExpr
e JStat
s2 -> Bool -> JExpr -> JStat -> JStat
WhileStat Bool
b (JExpr -> JExpr
map_expr JExpr
e) (JStat -> JStat
map_stat JStat
s2)
ForInStat Bool
b Ident
i JExpr
e JStat
s2 -> Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
b Ident
i (JExpr -> JExpr
map_expr JExpr
e) (JStat -> JStat
map_stat JStat
s2)
SwitchStat JExpr
e [(JExpr, JStat)]
les JStat
s2 -> JExpr -> [(JExpr, JStat)] -> JStat -> JStat
SwitchStat (JExpr -> JExpr
map_expr JExpr
e) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap JExpr -> JExpr
map_expr JStat -> JStat
map_stat) [(JExpr, JStat)]
les) (JStat -> JStat
map_stat JStat
s2)
TryStat JStat
s2 Ident
i JStat
s3 JStat
s4 -> JStat -> Ident -> JStat -> JStat -> JStat
TryStat (JStat -> JStat
map_stat JStat
s2) Ident
i (JStat -> JStat
map_stat JStat
s3) (JStat -> JStat
map_stat JStat
s4)
BlockStat [JStat]
ls -> [JStat] -> JStat
BlockStat (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JStat -> JStat
map_stat [JStat]
ls)
ApplStat JExpr
e [JExpr]
es -> JExpr -> [JExpr] -> JStat
ApplStat (JExpr -> JExpr
map_expr JExpr
e) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JExpr -> JExpr
map_expr [JExpr]
es)
UOpStat JUOp
o JExpr
e -> JUOp -> JExpr -> JStat
UOpStat JUOp
o (JExpr -> JExpr
map_expr JExpr
e)
AssignStat JExpr
e1 JExpr
e2 -> JExpr -> JExpr -> JStat
AssignStat (JExpr -> JExpr
map_expr JExpr
e1) (JExpr -> JExpr
map_expr JExpr
e2)
UnsatBlock IdentSupply JStat
ms -> IdentSupply JStat -> JStat
UnsatBlock (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JStat -> JStat
map_stat IdentSupply JStat
ms)
LabelStat JsLabel
l JStat
s2 -> JsLabel -> JStat -> JStat
LabelStat JsLabel
l (JStat -> JStat
map_stat JStat
s2)
BreakStat{} -> JStat
s
ContinueStat{} -> JStat
s
{-# INLINE identsS #-}
identsS :: JStat -> [Ident]
identsS :: JStat -> [Ident]
identsS = \case
DeclStat Ident
i Maybe JExpr
e -> [Ident
i] forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] JExpr -> [Ident]
identsE Maybe JExpr
e
ReturnStat JExpr
e -> JExpr -> [Ident]
identsE JExpr
e
IfStat JExpr
e JStat
s1 JStat
s2 -> JExpr -> [Ident]
identsE JExpr
e forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s1 forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s2
WhileStat Bool
_ JExpr
e JStat
s -> JExpr -> [Ident]
identsE JExpr
e forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s
ForInStat Bool
_ Ident
i JExpr
e JStat
s -> [Ident
i] forall a. [a] -> [a] -> [a]
++ JExpr -> [Ident]
identsE JExpr
e forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s
SwitchStat JExpr
e [(JExpr, JStat)]
xs JStat
s -> JExpr -> [Ident]
identsE JExpr
e forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (JExpr, JStat) -> [Ident]
traverseCase [(JExpr, JStat)]
xs forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s
where traverseCase :: (JExpr, JStat) -> [Ident]
traverseCase (JExpr
e,JStat
s) = JExpr -> [Ident]
identsE JExpr
e forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s
TryStat JStat
s1 Ident
i JStat
s2 JStat
s3 -> JStat -> [Ident]
identsS JStat
s1 forall a. [a] -> [a] -> [a]
++ [Ident
i] forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s2 forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s3
BlockStat [JStat]
xs -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap JStat -> [Ident]
identsS [JStat]
xs
ApplStat JExpr
e [JExpr]
es -> JExpr -> [Ident]
identsE JExpr
e forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap JExpr -> [Ident]
identsE [JExpr]
es
UOpStat JUOp
_op JExpr
e -> JExpr -> [Ident]
identsE JExpr
e
AssignStat JExpr
e1 JExpr
e2 -> JExpr -> [Ident]
identsE JExpr
e1 forall a. [a] -> [a] -> [a]
++ JExpr -> [Ident]
identsE JExpr
e2
UnsatBlock{} -> forall a. HasCallStack => [Char] -> a
error [Char]
"identsS: UnsatBlock"
LabelStat JsLabel
_l JStat
s -> JStat -> [Ident]
identsS JStat
s
BreakStat{} -> []
ContinueStat{} -> []
{-# INLINE identsE #-}
identsE :: JExpr -> [Ident]
identsE :: JExpr -> [Ident]
identsE = \case
ValExpr JVal
v -> JVal -> [Ident]
identsV JVal
v
SelExpr JExpr
e Ident
_i -> JExpr -> [Ident]
identsE JExpr
e
IdxExpr JExpr
e1 JExpr
e2 -> JExpr -> [Ident]
identsE JExpr
e1 forall a. [a] -> [a] -> [a]
++ JExpr -> [Ident]
identsE JExpr
e2
InfixExpr JOp
_ JExpr
e1 JExpr
e2 -> JExpr -> [Ident]
identsE JExpr
e1 forall a. [a] -> [a] -> [a]
++ JExpr -> [Ident]
identsE JExpr
e2
UOpExpr JUOp
_ JExpr
e -> JExpr -> [Ident]
identsE JExpr
e
IfExpr JExpr
e1 JExpr
e2 JExpr
e3 -> JExpr -> [Ident]
identsE JExpr
e1 forall a. [a] -> [a] -> [a]
++ JExpr -> [Ident]
identsE JExpr
e2 forall a. [a] -> [a] -> [a]
++ JExpr -> [Ident]
identsE JExpr
e3
ApplExpr JExpr
e [JExpr]
es -> JExpr -> [Ident]
identsE JExpr
e forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap JExpr -> [Ident]
identsE [JExpr]
es
UnsatExpr{} -> forall a. HasCallStack => [Char] -> a
error [Char]
"identsE: UnsatExpr"
{-# INLINE identsV #-}
identsV :: JVal -> [Ident]
identsV :: JVal -> [Ident]
identsV = \case
JVar Ident
i -> [Ident
i]
JList [JExpr]
xs -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap JExpr -> [Ident]
identsE [JExpr]
xs
JDouble{} -> []
JInt{} -> []
JStr{} -> []
JRegEx{} -> []
JHash UniqMap FastString JExpr
m -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (JExpr -> [Ident]
identsE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall k a. UniqMap k a -> [(k, a)]
nonDetEltsUniqMap UniqMap FastString JExpr
m)
JFunc [Ident]
args JStat
s -> [Ident]
args forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s
UnsatVal{} -> forall a. HasCallStack => [Char] -> a
error [Char]
"identsV: UnsatVal"
class JMacro a where
jtoGADT :: a -> JMGadt a
jfromGADT :: JMGadt a -> a
instance JMacro Ident where
jtoGADT :: Ident -> JMGadt Ident
jtoGADT = Ident -> JMGadt Ident
JMGId
jfromGADT :: JMGadt Ident -> Ident
jfromGADT (JMGId Ident
x) = Ident
x
instance JMacro JStat where
jtoGADT :: JStat -> JMGadt JStat
jtoGADT = JStat -> JMGadt JStat
JMGStat
jfromGADT :: JMGadt JStat -> JStat
jfromGADT (JMGStat JStat
x) = JStat
x
instance JMacro JExpr where
jtoGADT :: JExpr -> JMGadt JExpr
jtoGADT = JExpr -> JMGadt JExpr
JMGExpr
jfromGADT :: JMGadt JExpr -> JExpr
jfromGADT (JMGExpr JExpr
x) = JExpr
x
instance JMacro JVal where
jtoGADT :: JVal -> JMGadt JVal
jtoGADT = JVal -> JMGadt JVal
JMGVal
jfromGADT :: JMGadt JVal -> JVal
jfromGADT (JMGVal JVal
x) = JVal
x
data JMGadt a where
JMGId :: Ident -> JMGadt Ident
JMGStat :: JStat -> JMGadt JStat
JMGExpr :: JExpr -> JMGadt JExpr
JMGVal :: JVal -> JMGadt JVal
composOp :: Compos t => (forall a. t a -> t a) -> t b -> t b
composOp :: forall (t :: * -> *) b.
Compos t =>
(forall a. t a -> t a) -> t b -> t b
composOp forall a. t a -> t a
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) b.
(Compos t, Monad m) =>
(forall a. t a -> m (t a)) -> t b -> m (t b)
composOpM (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. t a -> t a
f)
composOpM :: (Compos t, Monad m) => (forall a. t a -> m (t a)) -> t b -> m (t b)
composOpM :: forall (t :: * -> *) (m :: * -> *) b.
(Compos t, Monad m) =>
(forall a. t a -> m (t a)) -> t b -> m (t b)
composOpM = forall (t :: * -> *) (m :: * -> *) c.
Compos t =>
(forall a. a -> m a)
-> (forall a b. m (a -> b) -> m a -> m b)
-> (forall a. t a -> m (t a))
-> t c
-> m (t c)
compos forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
composOpM_ :: (Compos t, Monad m) => (forall a. t a -> m ()) -> t b -> m ()
composOpM_ :: forall (t :: * -> *) (m :: * -> *) b.
(Compos t, Monad m) =>
(forall a. t a -> m ()) -> t b -> m ()
composOpM_ = forall (t :: * -> *) b c.
Compos t =>
b -> (b -> b -> b) -> (forall a. t a -> b) -> t c -> b
composOpFold (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)
composOpFold :: Compos t => b -> (b -> b -> b) -> (forall a. t a -> b) -> t c -> b
composOpFold :: forall (t :: * -> *) b c.
Compos t =>
b -> (b -> b -> b) -> (forall a. t a -> b) -> t c -> b
composOpFold b
z b -> b -> b
c forall a. t a -> b
f = forall b a. C b a -> b
unC forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) c.
Compos t =>
(forall a. a -> m a)
-> (forall a b. m (a -> b) -> m a -> m b)
-> (forall a. t a -> m (t a))
-> t c
-> m (t c)
compos (\a
_ -> forall b a. b -> C b a
C b
z) (\(C b
x) (C b
y) -> forall b a. b -> C b a
C (b -> b -> b
c b
x b
y)) (forall b a. b -> C b a
C forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. t a -> b
f)
newtype C b a = C { forall b a. C b a -> b
unC :: b }
class Compos t where
compos :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b)
-> (forall a. t a -> m (t a)) -> t c -> m (t c)
instance Compos JMGadt where
compos :: forall (m :: * -> *) c.
(forall a. a -> m a)
-> (forall a b. m (a -> b) -> m a -> m b)
-> (forall a. JMGadt a -> m (JMGadt a))
-> JMGadt c
-> m (JMGadt c)
compos = forall (m :: * -> *) c.
(forall a. a -> m a)
-> (forall a b. m (a -> b) -> m a -> m b)
-> (forall a. JMGadt a -> m (JMGadt a))
-> JMGadt c
-> m (JMGadt c)
jmcompos
jmcompos :: forall m c. (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b) -> (forall a. JMGadt a -> m (JMGadt a)) -> JMGadt c -> m (JMGadt c)
jmcompos :: forall (m :: * -> *) c.
(forall a. a -> m a)
-> (forall a b. m (a -> b) -> m a -> m b)
-> (forall a. JMGadt a -> m (JMGadt a))
-> JMGadt c
-> m (JMGadt c)
jmcompos forall a. a -> m a
ret forall a b. m (a -> b) -> m a -> m b
app forall a. JMGadt a -> m (JMGadt a)
f' JMGadt c
v =
case JMGadt c
v of
JMGId Ident
_ -> forall a. a -> m a
ret JMGadt c
v
JMGStat JStat
v' -> forall a. a -> m a
ret JStat -> JMGadt JStat
JMGStat forall a b. m (a -> b) -> m a -> m b
`app` case JStat
v' of
DeclStat Ident
i Maybe JExpr
e -> forall a. a -> m a
ret Ident -> Maybe JExpr -> JStat
DeclStat forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f Ident
i forall a b. m (a -> b) -> m a -> m b
`app` forall a. (a -> m a) -> Maybe a -> m (Maybe a)
mapMaybeM' forall b. JMacro b => b -> m b
f Maybe JExpr
e
ReturnStat JExpr
i -> forall a. a -> m a
ret JExpr -> JStat
ReturnStat forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
i
IfStat JExpr
e JStat
s JStat
s' -> forall a. a -> m a
ret JExpr -> JStat -> JStat -> JStat
IfStat forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s'
WhileStat Bool
b JExpr
e JStat
s -> forall a. a -> m a
ret (Bool -> JExpr -> JStat -> JStat
WhileStat Bool
b) forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s
ForInStat Bool
b Ident
i JExpr
e JStat
s -> forall a. a -> m a
ret (Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
b) forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f Ident
i forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s
SwitchStat JExpr
e [(JExpr, JStat)]
l JStat
d -> forall a. a -> m a
ret JExpr -> [(JExpr, JStat)] -> JStat -> JStat
SwitchStat forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` m [(JExpr, JStat)]
l' forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
d
where l' :: m [(JExpr, JStat)]
l' = forall a. (a -> m a) -> [a] -> m [a]
mapM' (\(JExpr
c,JStat
s) -> forall a. a -> m a
ret (,) forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
c forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s) [(JExpr, JStat)]
l
BlockStat [JStat]
xs -> forall a. a -> m a
ret [JStat] -> JStat
BlockStat forall a b. m (a -> b) -> m a -> m b
`app` forall a. (a -> m a) -> [a] -> m [a]
mapM' forall b. JMacro b => b -> m b
f [JStat]
xs
ApplStat JExpr
e [JExpr]
xs -> forall a. a -> m a
ret JExpr -> [JExpr] -> JStat
ApplStat forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall a. (a -> m a) -> [a] -> m [a]
mapM' forall b. JMacro b => b -> m b
f [JExpr]
xs
TryStat JStat
s Ident
i JStat
s1 JStat
s2 -> forall a. a -> m a
ret JStat -> Ident -> JStat -> JStat -> JStat
TryStat forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f Ident
i forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s1 forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s2
UOpStat JUOp
o JExpr
e -> forall a. a -> m a
ret (JUOp -> JExpr -> JStat
UOpStat JUOp
o) forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e
AssignStat JExpr
e JExpr
e' -> forall a. a -> m a
ret JExpr -> JExpr -> JStat
AssignStat forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e'
UnsatBlock IdentSupply JStat
_ -> forall a. a -> m a
ret JStat
v'
ContinueStat Maybe JsLabel
l -> forall a. a -> m a
ret (Maybe JsLabel -> JStat
ContinueStat Maybe JsLabel
l)
BreakStat Maybe JsLabel
l -> forall a. a -> m a
ret (Maybe JsLabel -> JStat
BreakStat Maybe JsLabel
l)
LabelStat JsLabel
l JStat
s -> forall a. a -> m a
ret (JsLabel -> JStat -> JStat
LabelStat JsLabel
l) forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s
JMGExpr JExpr
v' -> forall a. a -> m a
ret JExpr -> JMGadt JExpr
JMGExpr forall a b. m (a -> b) -> m a -> m b
`app` case JExpr
v' of
ValExpr JVal
e -> forall a. a -> m a
ret JVal -> JExpr
ValExpr forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JVal
e
SelExpr JExpr
e Ident
e' -> forall a. a -> m a
ret JExpr -> Ident -> JExpr
SelExpr forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f Ident
e'
IdxExpr JExpr
e JExpr
e' -> forall a. a -> m a
ret JExpr -> JExpr -> JExpr
IdxExpr forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e'
InfixExpr JOp
o JExpr
e JExpr
e' -> forall a. a -> m a
ret (JOp -> JExpr -> JExpr -> JExpr
InfixExpr JOp
o) forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e'
UOpExpr JUOp
o JExpr
e -> forall a. a -> m a
ret (JUOp -> JExpr -> JExpr
UOpExpr JUOp
o) forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e
IfExpr JExpr
e JExpr
e' JExpr
e'' -> forall a. a -> m a
ret JExpr -> JExpr -> JExpr -> JExpr
IfExpr forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e' forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e''
ApplExpr JExpr
e [JExpr]
xs -> forall a. a -> m a
ret JExpr -> [JExpr] -> JExpr
ApplExpr forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall a. (a -> m a) -> [a] -> m [a]
mapM' forall b. JMacro b => b -> m b
f [JExpr]
xs
UnsatExpr IdentSupply JExpr
_ -> forall a. a -> m a
ret JExpr
v'
JMGVal JVal
v' -> forall a. a -> m a
ret JVal -> JMGadt JVal
JMGVal forall a b. m (a -> b) -> m a -> m b
`app` case JVal
v' of
JVar Ident
i -> forall a. a -> m a
ret Ident -> JVal
JVar forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f Ident
i
JList [JExpr]
xs -> forall a. a -> m a
ret [JExpr] -> JVal
JList forall a b. m (a -> b) -> m a -> m b
`app` forall a. (a -> m a) -> [a] -> m [a]
mapM' forall b. JMacro b => b -> m b
f [JExpr]
xs
JDouble SaneDouble
_ -> forall a. a -> m a
ret JVal
v'
JInt Integer
_ -> forall a. a -> m a
ret JVal
v'
JStr FastString
_ -> forall a. a -> m a
ret JVal
v'
JRegEx FastString
_ -> forall a. a -> m a
ret JVal
v'
JHash UniqMap FastString JExpr
m -> forall a. a -> m a
ret UniqMap FastString JExpr -> JVal
JHash forall a b. m (a -> b) -> m a -> m b
`app` m (UniqMap FastString JExpr)
m'
where ([FastString]
ls, [JExpr]
vs) = forall a b. [(a, b)] -> ([a], [b])
unzip (forall k a. UniqMap k a -> [(k, a)]
nonDetEltsUniqMap UniqMap FastString JExpr
m)
m' :: m (UniqMap FastString JExpr)
m' = forall a. a -> m a
ret (forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [FastString]
ls) forall a b. m (a -> b) -> m a -> m b
`app` forall a. (a -> m a) -> [a] -> m [a]
mapM' forall b. JMacro b => b -> m b
f [JExpr]
vs
JFunc [Ident]
xs JStat
s -> forall a. a -> m a
ret [Ident] -> JStat -> JVal
JFunc forall a b. m (a -> b) -> m a -> m b
`app` forall a. (a -> m a) -> [a] -> m [a]
mapM' forall b. JMacro b => b -> m b
f [Ident]
xs forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s
UnsatVal IdentSupply JVal
_ -> forall a. a -> m a
ret JVal
v'
where
mapM' :: forall a. (a -> m a) -> [a] -> m [a]
mapM' :: forall a. (a -> m a) -> [a] -> m [a]
mapM' a -> m a
g = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b. m (a -> b) -> m a -> m b
app forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. m (a -> b) -> m a -> m b
app (forall a. a -> m a
ret (:)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
g) (forall a. a -> m a
ret [])
mapMaybeM' :: forall a. (a -> m a) -> Maybe a -> m (Maybe a)
mapMaybeM' :: forall a. (a -> m a) -> Maybe a -> m (Maybe a)
mapMaybeM' a -> m a
g = \case
Maybe a
Nothing -> forall a. a -> m a
ret forall a. Maybe a
Nothing
Just a
a -> forall a b. m (a -> b) -> m a -> m b
app (forall a. a -> m a
ret forall a. a -> Maybe a
Just) (a -> m a
g a
a)
f :: forall b. JMacro b => b -> m b
f :: forall b. JMacro b => b -> m b
f b
x = forall a. a -> m a
ret forall a. JMacro a => JMGadt a -> a
jfromGADT forall a b. m (a -> b) -> m a -> m b
`app` forall a. JMGadt a -> m (JMGadt a)
f' (forall a. JMacro a => a -> JMGadt a
jtoGADT b
x)
jsSaturate :: (JMacro a) => Maybe FastString -> a -> a
jsSaturate :: forall a. JMacro a => Maybe FastString -> a -> a
jsSaturate Maybe FastString
str a
x = forall s a. State s a -> s -> a
evalState (forall a. IdentSupply a -> State [Ident] a
runIdentSupply forall a b. (a -> b) -> a -> b
$ forall a. JMacro a => a -> IdentSupply a
jsSaturate_ a
x) (Maybe FastString -> [Ident]
newIdentSupply Maybe FastString
str)
jsSaturate_ :: (JMacro a) => a -> IdentSupply a
jsSaturate_ :: forall a. JMacro a => a -> IdentSupply a
jsSaturate_ a
e = forall a. State [Ident] a -> IdentSupply a
IS forall a b. (a -> b) -> a -> b
$ forall a. JMacro a => JMGadt a -> a
jfromGADT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMGadt a -> State [Ident] (JMGadt a)
go (forall a. JMacro a => a -> JMGadt a
jtoGADT a
e)
where
go :: forall a. JMGadt a -> State [Ident] (JMGadt a)
go :: forall a. JMGadt a -> State [Ident] (JMGadt a)
go JMGadt a
v = case JMGadt a
v of
JMGStat (UnsatBlock IdentSupply JStat
us) -> forall a. JMGadt a -> State [Ident] (JMGadt a)
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JStat -> JMGadt JStat
JMGStat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply JStat
us)
JMGExpr (UnsatExpr IdentSupply JExpr
us) -> forall a. JMGadt a -> State [Ident] (JMGadt a)
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JExpr -> JMGadt JExpr
JMGExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply JExpr
us)
JMGVal (UnsatVal IdentSupply JVal
us) -> forall a. JMGadt a -> State [Ident] (JMGadt a)
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JVal -> JMGadt JVal
JMGVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply JVal
us)
JMGadt a
_ -> forall (t :: * -> *) (m :: * -> *) b.
(Compos t, Monad m) =>
(forall a. t a -> m (t a)) -> t b -> m (t b)
composOpM forall a. JMGadt a -> State [Ident] (JMGadt a)
go JMGadt a
v