{-# 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
  -- * Saturation
  , jsSaturate
  -- * Generic traversal (via compos)
  , 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)

-- | Map on every variable ident
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 -- do not rename properties
  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"


{--------------------------------------------------------------------
  Compos
--------------------------------------------------------------------}
-- | Compos and ops for generic traversal as defined over
-- the JMacro ADT.

-- | Utility class to coerce the ADT into a regular structure.

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

-- | Union type to allow regular traversal by compos.
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'
               -- nonDetEltsUniqMap doesn't introduce nondeterminism here because the
               -- elements are treated independently before being re-added to a UniqMap
               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)

{--------------------------------------------------------------------
  Saturation
--------------------------------------------------------------------}

-- | Given an optional prefix, fills in all free variable names with a supply
-- of names generated by the prefix.
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