{-# 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 = (JExpr -> JExpr, JStat -> JStat) -> JExpr -> JExpr
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 = (JExpr -> JExpr, JStat -> JStat) -> JStat -> JStat
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) ((JExpr -> JExpr) -> [JExpr] -> [JExpr]
forall a b. (a -> b) -> [a] -> [b]
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 ((JExpr -> JExpr) -> IdentSupply JExpr -> IdentSupply JExpr
forall a b. (a -> b) -> IdentSupply a -> IdentSupply b
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 (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ [JExpr] -> JVal
JList ((JExpr -> JExpr) -> [JExpr] -> [JExpr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JExpr -> JExpr
map_expr [JExpr]
es)
      JDouble{}   -> JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ JVal
v
      JInt{}      -> JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ JVal
v
      JStr{}      -> JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ JVal
v
      JRegEx{}    -> JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ JVal
v
      JHash UniqMap FastString JExpr
me    -> JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ UniqMap FastString JExpr -> JVal
JHash ((JExpr -> JExpr)
-> UniqMap FastString JExpr -> UniqMap FastString JExpr
forall a b.
(a -> b) -> UniqMap FastString a -> UniqMap FastString b
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 (JVal -> JExpr) -> JVal -> JExpr
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 (JVal -> JExpr) -> JVal -> JExpr
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 ((JExpr -> JExpr) -> Maybe JExpr -> Maybe JExpr
forall a b. (a -> b) -> Maybe a -> Maybe b
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) (((JExpr, JStat) -> (JExpr, JStat))
-> [(JExpr, JStat)] -> [(JExpr, JStat)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((JExpr -> JExpr)
-> (JStat -> JStat) -> (JExpr, JStat) -> (JExpr, JStat)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
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 ((JStat -> JStat) -> [JStat] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
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) ((JExpr -> JExpr) -> [JExpr] -> [JExpr]
forall a b. (a -> b) -> [a] -> [b]
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 ((JStat -> JStat) -> IdentSupply JStat -> IdentSupply JStat
forall a b. (a -> b) -> IdentSupply a -> IdentSupply b
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] [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ [Ident] -> (JExpr -> [Ident]) -> Maybe JExpr -> [Ident]
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 [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s1 [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s2
  WhileStat Bool
_ JExpr
e JStat
s    -> JExpr -> [Ident]
identsE JExpr
e [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s
  ForInStat Bool
_ Ident
i JExpr
e JStat
s  -> [Ident
i] [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ JExpr -> [Ident]
identsE JExpr
e [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s
  SwitchStat JExpr
e [(JExpr, JStat)]
xs JStat
s  -> JExpr -> [Ident]
identsE JExpr
e [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ ((JExpr, JStat) -> [Ident]) -> [(JExpr, JStat)] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (JExpr, JStat) -> [Ident]
traverseCase [(JExpr, JStat)]
xs [Ident] -> [Ident] -> [Ident]
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 [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s
  TryStat JStat
s1 Ident
i JStat
s2 JStat
s3 -> JStat -> [Ident]
identsS JStat
s1 [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ [Ident
i] [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s2 [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s3
  BlockStat [JStat]
xs       -> (JStat -> [Ident]) -> [JStat] -> [Ident]
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 [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ (JExpr -> [Ident]) -> [JExpr] -> [Ident]
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 [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ JExpr -> [Ident]
identsE JExpr
e2
  UnsatBlock{}       -> [Char] -> [Ident]
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 [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ JExpr -> [Ident]
identsE JExpr
e2
  InfixExpr JOp
_ JExpr
e1 JExpr
e2 -> JExpr -> [Ident]
identsE JExpr
e1 [Ident] -> [Ident] -> [Ident]
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 [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ JExpr -> [Ident]
identsE JExpr
e2 [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ JExpr -> [Ident]
identsE JExpr
e3
  ApplExpr JExpr
e [JExpr]
es     -> JExpr -> [Ident]
identsE JExpr
e  [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ (JExpr -> [Ident]) -> [JExpr] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap JExpr -> [Ident]
identsE [JExpr]
es
  UnsatExpr{}       -> [Char] -> [Ident]
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     -> (JExpr -> [Ident]) -> [JExpr] -> [Ident]
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      -> ((FastString, JExpr) -> [Ident])
-> [(FastString, JExpr)] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (JExpr -> [Ident]
identsE (JExpr -> [Ident])
-> ((FastString, JExpr) -> JExpr) -> (FastString, JExpr) -> [Ident]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FastString, JExpr) -> JExpr
forall a b. (a, b) -> b
snd) (UniqMap FastString JExpr -> [(FastString, JExpr)]
forall k a. UniqMap k a -> [(k, a)]
nonDetEltsUniqMap UniqMap FastString JExpr
m)
  JFunc [Ident]
args JStat
s -> [Ident]
args [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ JStat -> [Ident]
identsS JStat
s
  UnsatVal{}   -> [Char] -> [Ident]
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 = Identity (t b) -> t b
forall a. Identity a -> a
runIdentity (Identity (t b) -> t b) -> (t b -> Identity (t b)) -> t b -> t b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. t a -> Identity (t a)) -> t b -> Identity (t b)
forall (t :: * -> *) (m :: * -> *) b.
(Compos t, Monad m) =>
(forall a. t a -> m (t a)) -> t b -> m (t b)
composOpM (t a -> Identity (t a)
forall a. a -> Identity a
Identity (t a -> Identity (t a)) -> (t a -> t a) -> t a -> Identity (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> t a
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 a. a -> m a)
-> (forall a b. m (a -> b) -> m a -> m b)
-> (forall a. t a -> m (t a))
-> t b
-> m (t b)
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)
forall (m :: * -> *) c.
(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 -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return m (a -> b) -> m a -> m b
forall a b. m (a -> b) -> m a -> m b
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_ = m ()
-> (m () -> m () -> m ()) -> (forall a. t a -> m ()) -> t b -> m ()
forall (t :: * -> *) b c.
Compos t =>
b -> (b -> b -> b) -> (forall a. t a -> b) -> t c -> b
composOpFold (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) m () -> m () -> m ()
forall a b. m a -> m b -> m b
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 = C b (t c) -> b
forall b a. C b a -> b
unC (C b (t c) -> b) -> (t c -> C b (t c)) -> t c -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> C b a)
-> (forall a b. C b (a -> b) -> C b a -> C b b)
-> (forall a. t a -> C b (t a))
-> t c
-> C b (t 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)
forall (m :: * -> *) c.
(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
_ -> b -> C b a
forall b a. b -> C b a
C b
z) (\(C b
x) (C b
y) -> b -> C b b
forall b a. b -> C b a
C (b -> b -> b
c b
x b
y)) (b -> C b (t a)
forall b a. b -> C b a
C (b -> C b (t a)) -> (t a -> b) -> t a -> C b (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> b
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 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)
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
_ -> JMGadt c -> m (JMGadt c)
forall a. a -> m a
ret JMGadt c
v
     JMGStat JStat
v' -> (JStat -> JMGadt c) -> m (JStat -> JMGadt c)
forall a. a -> m a
ret JStat -> JMGadt c
JStat -> JMGadt JStat
JMGStat m (JStat -> JMGadt c) -> m JStat -> m (JMGadt c)
forall a b. m (a -> b) -> m a -> m b
`app` case JStat
v' of
           DeclStat Ident
i Maybe JExpr
e -> (Ident -> Maybe JExpr -> JStat)
-> m (Ident -> Maybe JExpr -> JStat)
forall a. a -> m a
ret Ident -> Maybe JExpr -> JStat
DeclStat m (Ident -> Maybe JExpr -> JStat)
-> m Ident -> m (Maybe JExpr -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` Ident -> m Ident
forall b. JMacro b => b -> m b
f Ident
i m (Maybe JExpr -> JStat) -> m (Maybe JExpr) -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` (JExpr -> m JExpr) -> Maybe JExpr -> m (Maybe JExpr)
forall a. (a -> m a) -> Maybe a -> m (Maybe a)
mapMaybeM' JExpr -> m JExpr
forall b. JMacro b => b -> m b
f Maybe JExpr
e
           ReturnStat JExpr
i -> (JExpr -> JStat) -> m (JExpr -> JStat)
forall a. a -> m a
ret JExpr -> JStat
ReturnStat m (JExpr -> JStat) -> m JExpr -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
i
           IfStat JExpr
e JStat
s JStat
s' -> (JExpr -> JStat -> JStat -> JStat)
-> m (JExpr -> JStat -> JStat -> JStat)
forall a. a -> m a
ret JExpr -> JStat -> JStat -> JStat
IfStat m (JExpr -> JStat -> JStat -> JStat)
-> m JExpr -> m (JStat -> JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (JStat -> JStat -> JStat) -> m JStat -> m (JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s m (JStat -> JStat) -> m JStat -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s'
           WhileStat Bool
b JExpr
e JStat
s -> (JExpr -> JStat -> JStat) -> m (JExpr -> JStat -> JStat)
forall a. a -> m a
ret (Bool -> JExpr -> JStat -> JStat
WhileStat Bool
b) m (JExpr -> JStat -> JStat) -> m JExpr -> m (JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (JStat -> JStat) -> m JStat -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s
           ForInStat Bool
b Ident
i JExpr
e JStat
s -> (Ident -> JExpr -> JStat -> JStat)
-> m (Ident -> JExpr -> JStat -> JStat)
forall a. a -> m a
ret (Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
b) m (Ident -> JExpr -> JStat -> JStat)
-> m Ident -> m (JExpr -> JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` Ident -> m Ident
forall b. JMacro b => b -> m b
f Ident
i m (JExpr -> JStat -> JStat) -> m JExpr -> m (JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (JStat -> JStat) -> m JStat -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s
           SwitchStat JExpr
e [(JExpr, JStat)]
l JStat
d -> (JExpr -> [(JExpr, JStat)] -> JStat -> JStat)
-> m (JExpr -> [(JExpr, JStat)] -> JStat -> JStat)
forall a. a -> m a
ret JExpr -> [(JExpr, JStat)] -> JStat -> JStat
SwitchStat m (JExpr -> [(JExpr, JStat)] -> JStat -> JStat)
-> m JExpr -> m ([(JExpr, JStat)] -> JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m ([(JExpr, JStat)] -> JStat -> JStat)
-> m [(JExpr, JStat)] -> m (JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` m [(JExpr, JStat)]
l' m (JStat -> JStat) -> m JStat -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
d
               where l' :: m [(JExpr, JStat)]
l' = ((JExpr, JStat) -> m (JExpr, JStat))
-> [(JExpr, JStat)] -> m [(JExpr, JStat)]
forall a. (a -> m a) -> [a] -> m [a]
mapM' (\(JExpr
c,JStat
s) -> (JExpr -> JStat -> (JExpr, JStat))
-> m (JExpr -> JStat -> (JExpr, JStat))
forall a. a -> m a
ret (,) m (JExpr -> JStat -> (JExpr, JStat))
-> m JExpr -> m (JStat -> (JExpr, JStat))
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
c m (JStat -> (JExpr, JStat)) -> m JStat -> m (JExpr, JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s) [(JExpr, JStat)]
l
           BlockStat [JStat]
xs -> ([JStat] -> JStat) -> m ([JStat] -> JStat)
forall a. a -> m a
ret [JStat] -> JStat
BlockStat m ([JStat] -> JStat) -> m [JStat] -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` (JStat -> m JStat) -> [JStat] -> m [JStat]
forall a. (a -> m a) -> [a] -> m [a]
mapM' JStat -> m JStat
forall b. JMacro b => b -> m b
f [JStat]
xs
           ApplStat  JExpr
e [JExpr]
xs -> (JExpr -> [JExpr] -> JStat) -> m (JExpr -> [JExpr] -> JStat)
forall a. a -> m a
ret JExpr -> [JExpr] -> JStat
ApplStat m (JExpr -> [JExpr] -> JStat) -> m JExpr -> m ([JExpr] -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m ([JExpr] -> JStat) -> m [JExpr] -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` (JExpr -> m JExpr) -> [JExpr] -> m [JExpr]
forall a. (a -> m a) -> [a] -> m [a]
mapM' JExpr -> m JExpr
forall b. JMacro b => b -> m b
f [JExpr]
xs
           TryStat JStat
s Ident
i JStat
s1 JStat
s2 -> (JStat -> Ident -> JStat -> JStat -> JStat)
-> m (JStat -> Ident -> JStat -> JStat -> JStat)
forall a. a -> m a
ret JStat -> Ident -> JStat -> JStat -> JStat
TryStat m (JStat -> Ident -> JStat -> JStat -> JStat)
-> m JStat -> m (Ident -> JStat -> JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s m (Ident -> JStat -> JStat -> JStat)
-> m Ident -> m (JStat -> JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` Ident -> m Ident
forall b. JMacro b => b -> m b
f Ident
i m (JStat -> JStat -> JStat) -> m JStat -> m (JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s1 m (JStat -> JStat) -> m JStat -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s2
           UOpStat JUOp
o JExpr
e -> (JExpr -> JStat) -> m (JExpr -> JStat)
forall a. a -> m a
ret (JUOp -> JExpr -> JStat
UOpStat JUOp
o) m (JExpr -> JStat) -> m JExpr -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e
           AssignStat JExpr
e JExpr
e' -> (JExpr -> JExpr -> JStat) -> m (JExpr -> JExpr -> JStat)
forall a. a -> m a
ret JExpr -> JExpr -> JStat
AssignStat m (JExpr -> JExpr -> JStat) -> m JExpr -> m (JExpr -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (JExpr -> JStat) -> m JExpr -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e'
           UnsatBlock IdentSupply JStat
_ -> JStat -> m JStat
forall a. a -> m a
ret JStat
v'
           ContinueStat Maybe JsLabel
l -> JStat -> m JStat
forall a. a -> m a
ret (Maybe JsLabel -> JStat
ContinueStat Maybe JsLabel
l)
           BreakStat Maybe JsLabel
l -> JStat -> m JStat
forall a. a -> m a
ret (Maybe JsLabel -> JStat
BreakStat Maybe JsLabel
l)
           LabelStat JsLabel
l JStat
s -> (JStat -> JStat) -> m (JStat -> JStat)
forall a. a -> m a
ret (JsLabel -> JStat -> JStat
LabelStat JsLabel
l) m (JStat -> JStat) -> m JStat -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s
     JMGExpr JExpr
v' -> (JExpr -> JMGadt c) -> m (JExpr -> JMGadt c)
forall a. a -> m a
ret JExpr -> JMGadt c
JExpr -> JMGadt JExpr
JMGExpr m (JExpr -> JMGadt c) -> m JExpr -> m (JMGadt c)
forall a b. m (a -> b) -> m a -> m b
`app` case JExpr
v' of
           ValExpr JVal
e -> (JVal -> JExpr) -> m (JVal -> JExpr)
forall a. a -> m a
ret JVal -> JExpr
ValExpr m (JVal -> JExpr) -> m JVal -> m JExpr
forall a b. m (a -> b) -> m a -> m b
`app` JVal -> m JVal
forall b. JMacro b => b -> m b
f JVal
e
           SelExpr JExpr
e Ident
e' -> (JExpr -> Ident -> JExpr) -> m (JExpr -> Ident -> JExpr)
forall a. a -> m a
ret JExpr -> Ident -> JExpr
SelExpr m (JExpr -> Ident -> JExpr) -> m JExpr -> m (Ident -> JExpr)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (Ident -> JExpr) -> m Ident -> m JExpr
forall a b. m (a -> b) -> m a -> m b
`app` Ident -> m Ident
forall b. JMacro b => b -> m b
f Ident
e'
           IdxExpr JExpr
e JExpr
e' -> (JExpr -> JExpr -> JExpr) -> m (JExpr -> JExpr -> JExpr)
forall a. a -> m a
ret JExpr -> JExpr -> JExpr
IdxExpr m (JExpr -> JExpr -> JExpr) -> m JExpr -> m (JExpr -> JExpr)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (JExpr -> JExpr) -> m JExpr -> m JExpr
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e'
           InfixExpr JOp
o JExpr
e JExpr
e' -> (JExpr -> JExpr -> JExpr) -> m (JExpr -> JExpr -> JExpr)
forall a. a -> m a
ret (JOp -> JExpr -> JExpr -> JExpr
InfixExpr JOp
o) m (JExpr -> JExpr -> JExpr) -> m JExpr -> m (JExpr -> JExpr)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (JExpr -> JExpr) -> m JExpr -> m JExpr
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e'
           UOpExpr JUOp
o JExpr
e -> (JExpr -> JExpr) -> m (JExpr -> JExpr)
forall a. a -> m a
ret (JUOp -> JExpr -> JExpr
UOpExpr JUOp
o) m (JExpr -> JExpr) -> m JExpr -> m JExpr
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e
           IfExpr JExpr
e JExpr
e' JExpr
e'' -> (JExpr -> JExpr -> JExpr -> JExpr)
-> m (JExpr -> JExpr -> JExpr -> JExpr)
forall a. a -> m a
ret JExpr -> JExpr -> JExpr -> JExpr
IfExpr m (JExpr -> JExpr -> JExpr -> JExpr)
-> m JExpr -> m (JExpr -> JExpr -> JExpr)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (JExpr -> JExpr -> JExpr) -> m JExpr -> m (JExpr -> JExpr)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e' m (JExpr -> JExpr) -> m JExpr -> m JExpr
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e''
           ApplExpr JExpr
e [JExpr]
xs -> (JExpr -> [JExpr] -> JExpr) -> m (JExpr -> [JExpr] -> JExpr)
forall a. a -> m a
ret JExpr -> [JExpr] -> JExpr
ApplExpr m (JExpr -> [JExpr] -> JExpr) -> m JExpr -> m ([JExpr] -> JExpr)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m ([JExpr] -> JExpr) -> m [JExpr] -> m JExpr
forall a b. m (a -> b) -> m a -> m b
`app` (JExpr -> m JExpr) -> [JExpr] -> m [JExpr]
forall a. (a -> m a) -> [a] -> m [a]
mapM' JExpr -> m JExpr
forall b. JMacro b => b -> m b
f [JExpr]
xs
           UnsatExpr IdentSupply JExpr
_ -> JExpr -> m JExpr
forall a. a -> m a
ret JExpr
v'
     JMGVal JVal
v' -> (JVal -> JMGadt c) -> m (JVal -> JMGadt c)
forall a. a -> m a
ret JVal -> JMGadt c
JVal -> JMGadt JVal
JMGVal m (JVal -> JMGadt c) -> m JVal -> m (JMGadt c)
forall a b. m (a -> b) -> m a -> m b
`app` case JVal
v' of
           JVar Ident
i -> (Ident -> JVal) -> m (Ident -> JVal)
forall a. a -> m a
ret Ident -> JVal
JVar m (Ident -> JVal) -> m Ident -> m JVal
forall a b. m (a -> b) -> m a -> m b
`app` Ident -> m Ident
forall b. JMacro b => b -> m b
f Ident
i
           JList [JExpr]
xs -> ([JExpr] -> JVal) -> m ([JExpr] -> JVal)
forall a. a -> m a
ret [JExpr] -> JVal
JList m ([JExpr] -> JVal) -> m [JExpr] -> m JVal
forall a b. m (a -> b) -> m a -> m b
`app` (JExpr -> m JExpr) -> [JExpr] -> m [JExpr]
forall a. (a -> m a) -> [a] -> m [a]
mapM' JExpr -> m JExpr
forall b. JMacro b => b -> m b
f [JExpr]
xs
           JDouble SaneDouble
_ -> JVal -> m JVal
forall a. a -> m a
ret JVal
v'
           JInt    Integer
_ -> JVal -> m JVal
forall a. a -> m a
ret JVal
v'
           JStr    FastString
_ -> JVal -> m JVal
forall a. a -> m a
ret JVal
v'
           JRegEx  FastString
_ -> JVal -> m JVal
forall a. a -> m a
ret JVal
v'
           JHash   UniqMap FastString JExpr
m -> (UniqMap FastString JExpr -> JVal)
-> m (UniqMap FastString JExpr -> JVal)
forall a. a -> m a
ret UniqMap FastString JExpr -> JVal
JHash m (UniqMap FastString JExpr -> JVal)
-> m (UniqMap FastString JExpr) -> m JVal
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) = [(FastString, JExpr)] -> ([FastString], [JExpr])
forall a b. [(a, b)] -> ([a], [b])
unzip (UniqMap FastString JExpr -> [(FastString, JExpr)]
forall k a. UniqMap k a -> [(k, a)]
nonDetEltsUniqMap UniqMap FastString JExpr
m)
                     m' :: m (UniqMap FastString JExpr)
m' = ([JExpr] -> UniqMap FastString JExpr)
-> m ([JExpr] -> UniqMap FastString JExpr)
forall a. a -> m a
ret ([(FastString, JExpr)] -> UniqMap FastString JExpr
forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap ([(FastString, JExpr)] -> UniqMap FastString JExpr)
-> ([JExpr] -> [(FastString, JExpr)])
-> [JExpr]
-> UniqMap FastString JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FastString] -> [JExpr] -> [(FastString, JExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FastString]
ls) m ([JExpr] -> UniqMap FastString JExpr)
-> m [JExpr] -> m (UniqMap FastString JExpr)
forall a b. m (a -> b) -> m a -> m b
`app` (JExpr -> m JExpr) -> [JExpr] -> m [JExpr]
forall a. (a -> m a) -> [a] -> m [a]
mapM' JExpr -> m JExpr
forall b. JMacro b => b -> m b
f [JExpr]
vs
           JFunc [Ident]
xs JStat
s -> ([Ident] -> JStat -> JVal) -> m ([Ident] -> JStat -> JVal)
forall a. a -> m a
ret [Ident] -> JStat -> JVal
JFunc m ([Ident] -> JStat -> JVal) -> m [Ident] -> m (JStat -> JVal)
forall a b. m (a -> b) -> m a -> m b
`app` (Ident -> m Ident) -> [Ident] -> m [Ident]
forall a. (a -> m a) -> [a] -> m [a]
mapM' Ident -> m Ident
forall b. JMacro b => b -> m b
f [Ident]
xs m (JStat -> JVal) -> m JStat -> m JVal
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s
           UnsatVal IdentSupply JVal
_ -> JVal -> m 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 = (a -> m [a] -> m [a]) -> m [a] -> [a] -> m [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (m ([a] -> [a]) -> m [a] -> m [a]
forall a b. m (a -> b) -> m a -> m b
app (m ([a] -> [a]) -> m [a] -> m [a])
-> (a -> m ([a] -> [a])) -> a -> m [a] -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (a -> [a] -> [a]) -> m a -> m ([a] -> [a])
forall a b. m (a -> b) -> m a -> m b
app ((a -> [a] -> [a]) -> m (a -> [a] -> [a])
forall a. a -> m a
ret (:)) (m a -> m ([a] -> [a])) -> (a -> m a) -> a -> m ([a] -> [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
g) ([a] -> m [a]
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 -> Maybe a -> m (Maybe a)
forall a. a -> m a
ret Maybe a
forall a. Maybe a
Nothing
      Just a
a  -> m (a -> Maybe a) -> m a -> m (Maybe a)
forall a b. m (a -> b) -> m a -> m b
app ((a -> Maybe a) -> m (a -> Maybe a)
forall a. a -> m a
ret a -> Maybe a
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 = (JMGadt b -> b) -> m (JMGadt b -> b)
forall a. a -> m a
ret JMGadt b -> b
forall a. JMacro a => JMGadt a -> a
jfromGADT m (JMGadt b -> b) -> m (JMGadt b) -> m b
forall a b. m (a -> b) -> m a -> m b
`app` JMGadt b -> m (JMGadt b)
forall a. JMGadt a -> m (JMGadt a)
f' (b -> JMGadt b
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 = State [Ident] a -> [Ident] -> a
forall s a. State s a -> s -> a
evalState (IdentSupply a -> State [Ident] a
forall a. IdentSupply a -> State [Ident] a
runIdentSupply (IdentSupply a -> State [Ident] a)
-> IdentSupply a -> State [Ident] a
forall a b. (a -> b) -> a -> b
$ a -> IdentSupply a
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 = State [Ident] a -> IdentSupply a
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] a -> IdentSupply a)
-> State [Ident] a -> IdentSupply a
forall a b. (a -> b) -> a -> b
$ JMGadt a -> a
forall a. JMacro a => JMGadt a -> a
jfromGADT (JMGadt a -> a) -> State [Ident] (JMGadt a) -> State [Ident] a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMGadt a -> State [Ident] (JMGadt a)
forall a. JMGadt a -> State [Ident] (JMGadt a)
go (a -> JMGadt a
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) -> JMGadt a -> State [Ident] (JMGadt a)
forall a. JMGadt a -> State [Ident] (JMGadt a)
go (JMGadt a -> State [Ident] (JMGadt a))
-> State [Ident] (JMGadt a) -> State [Ident] (JMGadt a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JStat -> JMGadt a
JStat -> JMGadt JStat
JMGStat (JStat -> JMGadt a)
-> State [Ident] JStat -> State [Ident] (JMGadt a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdentSupply JStat -> State [Ident] JStat
forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply JStat
us)
               JMGExpr (UnsatExpr  IdentSupply JExpr
us) -> JMGadt a -> State [Ident] (JMGadt a)
forall a. JMGadt a -> State [Ident] (JMGadt a)
go (JMGadt a -> State [Ident] (JMGadt a))
-> State [Ident] (JMGadt a) -> State [Ident] (JMGadt a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JExpr -> JMGadt a
JExpr -> JMGadt JExpr
JMGExpr (JExpr -> JMGadt a)
-> State [Ident] JExpr -> State [Ident] (JMGadt a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdentSupply JExpr -> State [Ident] JExpr
forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply JExpr
us)
               JMGVal  (UnsatVal   IdentSupply JVal
us) -> JMGadt a -> State [Ident] (JMGadt a)
forall a. JMGadt a -> State [Ident] (JMGadt a)
go (JMGadt a -> State [Ident] (JMGadt a))
-> State [Ident] (JMGadt a) -> State [Ident] (JMGadt a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JVal -> JMGadt a
JVal -> JMGadt JVal
JMGVal  (JVal -> JMGadt a)
-> State [Ident] JVal -> State [Ident] (JMGadt a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdentSupply JVal -> State [Ident] JVal
forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply JVal
us)
               JMGadt a
_ -> (forall a. JMGadt a -> State [Ident] (JMGadt a))
-> JMGadt a -> State [Ident] (JMGadt a)
forall (t :: * -> *) (m :: * -> *) b.
(Compos t, Monad m) =>
(forall a. t a -> m (t a)) -> t b -> m (t b)
composOpM JMGadt a -> State [Ident] (JMGadt a)
forall a. JMGadt a -> State [Ident] (JMGadt a)
go JMGadt a
v