-- |
--
-- Functions for generic traversals across Futhark syntax trees.  The
-- motivation for this module came from dissatisfaction with rewriting
-- the same trivial tree recursions for every module.  A possible
-- alternative would be to use normal \"Scrap your
-- boilerplate\"-techniques, but these are rejected for two reasons:
--
--    * They are too slow.
--
--    * More importantly, they do not tell you whether you have missed
--      some cases.
--
-- Instead, this module defines various traversals of the Futhark syntax
-- tree.  The implementation is rather tedious, but the interface is
-- easy to use.
--
-- A traversal of the Futhark syntax tree is expressed as a record of
-- functions expressing the operations to be performed on the various
-- types of nodes.
module Language.Futhark.Traversals
  ( ASTMapper (..),
    ASTMappable (..),
    identityMapper,
    bareExp,
  )
where

import Data.Bifunctor
import Data.List.NonEmpty qualified as NE
import Language.Futhark.Syntax

-- | Express a monad mapping operation on a syntax node.  Each element
-- of this structure expresses the operation to be performed on a
-- given child.
data ASTMapper m = ASTMapper
  { forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp :: ExpBase Info VName -> m (ExpBase Info VName),
    forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName :: QualName VName -> m (QualName VName),
    forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType :: StructType -> m StructType,
    forall (m :: * -> *). ASTMapper m -> ParamType -> m ParamType
mapOnParamType :: ParamType -> m ParamType,
    forall (m :: * -> *). ASTMapper m -> ResRetType -> m ResRetType
mapOnResRetType :: ResRetType -> m ResRetType
  }

-- | An 'ASTMapper' that just leaves its input unchanged.
identityMapper :: (Monad m) => ASTMapper m
identityMapper :: forall (m :: * -> *). Monad m => ASTMapper m
identityMapper =
  ASTMapper
    { mapOnExp :: ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp = ExpBase Info VName -> m (ExpBase Info VName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      mapOnName :: QualName VName -> m (QualName VName)
mapOnName = QualName VName -> m (QualName VName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      mapOnStructType :: StructType -> m StructType
mapOnStructType = StructType -> m StructType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      mapOnParamType :: ParamType -> m ParamType
mapOnParamType = ParamType -> m ParamType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      mapOnResRetType :: ResRetType -> m ResRetType
mapOnResRetType = ResRetType -> m ResRetType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    }

-- | The class of things that we can map an 'ASTMapper' across.
class ASTMappable x where
  -- | Map a monadic action across the immediate children of an
  -- object.  Importantly, the 'astMap' action is not invoked for
  -- the object itself, and the mapping does not descend recursively
  -- into subexpressions.  The mapping is done left-to-right.
  astMap :: (Monad m) => ASTMapper m -> x -> m x

instance ASTMappable (AppExpBase Info VName) where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m -> AppExpBase Info VName -> m (AppExpBase Info VName)
astMap ASTMapper m
tv (Range ExpBase Info VName
start Maybe (ExpBase Info VName)
next Inclusiveness (ExpBase Info VName)
end SrcLoc
loc) =
    ExpBase Info VName
-> Maybe (ExpBase Info VName)
-> Inclusiveness (ExpBase Info VName)
-> SrcLoc
-> AppExpBase Info VName
forall (f :: * -> *) vn.
ExpBase f vn
-> Maybe (ExpBase f vn)
-> Inclusiveness (ExpBase f vn)
-> SrcLoc
-> AppExpBase f vn
Range
      (ExpBase Info VName
 -> Maybe (ExpBase Info VName)
 -> Inclusiveness (ExpBase Info VName)
 -> SrcLoc
 -> AppExpBase Info VName)
-> m (ExpBase Info VName)
-> m (Maybe (ExpBase Info VName)
      -> Inclusiveness (ExpBase Info VName)
      -> SrcLoc
      -> AppExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
start
      m (Maybe (ExpBase Info VName)
   -> Inclusiveness (ExpBase Info VName)
   -> SrcLoc
   -> AppExpBase Info VName)
-> m (Maybe (ExpBase Info VName))
-> m (Inclusiveness (ExpBase Info VName)
      -> SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ExpBase Info VName -> m (ExpBase Info VName))
-> Maybe (ExpBase Info VName) -> m (Maybe (ExpBase Info VName))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) Maybe (ExpBase Info VName)
next
      m (Inclusiveness (ExpBase Info VName)
   -> SrcLoc -> AppExpBase Info VName)
-> m (Inclusiveness (ExpBase Info VName))
-> m (SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ExpBase Info VName -> m (ExpBase Info VName))
-> Inclusiveness (ExpBase Info VName)
-> m (Inclusiveness (ExpBase Info VName))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Inclusiveness a -> f (Inclusiveness b)
traverse (ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) Inclusiveness (ExpBase Info VName)
end
      m (SrcLoc -> AppExpBase Info VName)
-> m SrcLoc -> m (AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (If ExpBase Info VName
c ExpBase Info VName
texp ExpBase Info VName
fexp SrcLoc
loc) =
    ExpBase Info VName
-> ExpBase Info VName
-> ExpBase Info VName
-> SrcLoc
-> AppExpBase Info VName
forall (f :: * -> *) vn.
ExpBase f vn
-> ExpBase f vn -> ExpBase f vn -> SrcLoc -> AppExpBase f vn
If (ExpBase Info VName
 -> ExpBase Info VName
 -> ExpBase Info VName
 -> SrcLoc
 -> AppExpBase Info VName)
-> m (ExpBase Info VName)
-> m (ExpBase Info VName
      -> ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
c m (ExpBase Info VName
   -> ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
-> m (ExpBase Info VName)
-> m (ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
texp m (ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
-> m (ExpBase Info VName) -> m (SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
fexp m (SrcLoc -> AppExpBase Info VName)
-> m SrcLoc -> m (AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Match ExpBase Info VName
e NonEmpty (CaseBase Info VName)
cases SrcLoc
loc) =
    ExpBase Info VName
-> NonEmpty (CaseBase Info VName)
-> SrcLoc
-> AppExpBase Info VName
forall (f :: * -> *) vn.
ExpBase f vn
-> NonEmpty (CaseBase f vn) -> SrcLoc -> AppExpBase f vn
Match (ExpBase Info VName
 -> NonEmpty (CaseBase Info VName)
 -> SrcLoc
 -> AppExpBase Info VName)
-> m (ExpBase Info VName)
-> m (NonEmpty (CaseBase Info VName)
      -> SrcLoc -> AppExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e m (NonEmpty (CaseBase Info VName)
   -> SrcLoc -> AppExpBase Info VName)
-> m (NonEmpty (CaseBase Info VName))
-> m (SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m
-> NonEmpty (CaseBase Info VName)
-> m (NonEmpty (CaseBase Info VName))
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m
-> NonEmpty (CaseBase Info VName)
-> m (NonEmpty (CaseBase Info VName))
astMap ASTMapper m
tv NonEmpty (CaseBase Info VName)
cases m (SrcLoc -> AppExpBase Info VName)
-> m SrcLoc -> m (AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Apply ExpBase Info VName
f NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
args SrcLoc
loc) = do
    ExpBase Info VName
f' <- ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
f
    NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
args' <- ((Info (Diet, Maybe VName), ExpBase Info VName)
 -> m (Info (Diet, Maybe VName), ExpBase Info VName))
-> NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
-> m (NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse ((ExpBase Info VName -> m (ExpBase Info VName))
-> (Info (Diet, Maybe VName), ExpBase Info VName)
-> m (Info (Diet, Maybe VName), ExpBase Info VName)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> (Info (Diet, Maybe VName), a) -> f (Info (Diet, Maybe VName), b)
traverse ((ExpBase Info VName -> m (ExpBase Info VName))
 -> (Info (Diet, Maybe VName), ExpBase Info VName)
 -> m (Info (Diet, Maybe VName), ExpBase Info VName))
-> (ExpBase Info VName -> m (ExpBase Info VName))
-> (Info (Diet, Maybe VName), ExpBase Info VName)
-> m (Info (Diet, Maybe VName), ExpBase Info VName)
forall a b. (a -> b) -> a -> b
$ ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
args
    -- Safe to disregard return type because existentials cannot be
    -- instantiated here, as the return is necessarily a function.
    AppExpBase Info VName -> m (AppExpBase Info VName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppExpBase Info VName -> m (AppExpBase Info VName))
-> AppExpBase Info VName -> m (AppExpBase Info VName)
forall a b. (a -> b) -> a -> b
$ case ExpBase Info VName
f' of
      AppExp (Apply ExpBase Info VName
f_inner NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
args_inner SrcLoc
_) Info AppRes
_ ->
        ExpBase Info VName
-> NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
-> SrcLoc
-> AppExpBase Info VName
forall (f :: * -> *) vn.
ExpBase f vn
-> NonEmpty (f (Diet, Maybe VName), ExpBase f vn)
-> SrcLoc
-> AppExpBase f vn
Apply ExpBase Info VName
f_inner (NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
args_inner NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
-> NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
-> NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
forall a. Semigroup a => a -> a -> a
<> NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
args') SrcLoc
loc
      ExpBase Info VName
_ ->
        ExpBase Info VName
-> NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
-> SrcLoc
-> AppExpBase Info VName
forall (f :: * -> *) vn.
ExpBase f vn
-> NonEmpty (f (Diet, Maybe VName), ExpBase f vn)
-> SrcLoc
-> AppExpBase f vn
Apply ExpBase Info VName
f' NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
args' SrcLoc
loc
  astMap ASTMapper m
tv (LetPat [SizeBinder VName]
sizes PatBase Info VName StructType
pat ExpBase Info VName
e ExpBase Info VName
body SrcLoc
loc) =
    [SizeBinder VName]
-> PatBase Info VName StructType
-> ExpBase Info VName
-> ExpBase Info VName
-> SrcLoc
-> AppExpBase Info VName
forall (f :: * -> *) vn.
[SizeBinder vn]
-> PatBase f vn StructType
-> ExpBase f vn
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
LetPat [SizeBinder VName]
sizes (PatBase Info VName StructType
 -> ExpBase Info VName
 -> ExpBase Info VName
 -> SrcLoc
 -> AppExpBase Info VName)
-> m (PatBase Info VName StructType)
-> m (ExpBase Info VName
      -> ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m
-> PatBase Info VName StructType
-> m (PatBase Info VName StructType)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m
-> PatBase Info VName StructType
-> m (PatBase Info VName StructType)
astMap ASTMapper m
tv PatBase Info VName StructType
pat m (ExpBase Info VName
   -> ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
-> m (ExpBase Info VName)
-> m (ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e m (ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
-> m (ExpBase Info VName) -> m (SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
body m (SrcLoc -> AppExpBase Info VName)
-> m SrcLoc -> m (AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (LetFun VName
name ([TypeParamBase VName]
tparams, [PatBase Info VName ParamType]
params, Maybe (TypeExp Info VName)
ret, Info ResRetType
t, ExpBase Info VName
e) ExpBase Info VName
body SrcLoc
loc) =
    VName
-> ([TypeParamBase VName], [PatBase Info VName ParamType],
    Maybe (TypeExp Info VName), Info ResRetType, ExpBase Info VName)
-> ExpBase Info VName
-> SrcLoc
-> AppExpBase Info VName
forall (f :: * -> *) vn.
vn
-> ([TypeParamBase vn], [PatBase f vn ParamType],
    Maybe (TypeExp f vn), f ResRetType, ExpBase f vn)
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
LetFun VName
name
      (([TypeParamBase VName], [PatBase Info VName ParamType],
  Maybe (TypeExp Info VName), Info ResRetType, ExpBase Info VName)
 -> ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
-> m ([TypeParamBase VName], [PatBase Info VName ParamType],
      Maybe (TypeExp Info VName), Info ResRetType, ExpBase Info VName)
-> m (ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ([TypeParamBase VName]
tparams,,,,)
              ([PatBase Info VName ParamType]
 -> Maybe (TypeExp Info VName)
 -> Info ResRetType
 -> ExpBase Info VName
 -> ([TypeParamBase VName], [PatBase Info VName ParamType],
     Maybe (TypeExp Info VName), Info ResRetType, ExpBase Info VName))
-> m [PatBase Info VName ParamType]
-> m (Maybe (TypeExp Info VName)
      -> Info ResRetType
      -> ExpBase Info VName
      -> ([TypeParamBase VName], [PatBase Info VName ParamType],
          Maybe (TypeExp Info VName), Info ResRetType, ExpBase Info VName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PatBase Info VName ParamType -> m (PatBase Info VName ParamType))
-> [PatBase Info VName ParamType]
-> m [PatBase Info VName ParamType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ASTMapper m
-> PatBase Info VName ParamType -> m (PatBase Info VName ParamType)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m
-> PatBase Info VName ParamType -> m (PatBase Info VName ParamType)
astMap ASTMapper m
tv) [PatBase Info VName ParamType]
params
              m (Maybe (TypeExp Info VName)
   -> Info ResRetType
   -> ExpBase Info VName
   -> ([TypeParamBase VName], [PatBase Info VName ParamType],
       Maybe (TypeExp Info VName), Info ResRetType, ExpBase Info VName))
-> m (Maybe (TypeExp Info VName))
-> m (Info ResRetType
      -> ExpBase Info VName
      -> ([TypeParamBase VName], [PatBase Info VName ParamType],
          Maybe (TypeExp Info VName), Info ResRetType, ExpBase Info VName))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TypeExp Info VName -> m (TypeExp Info VName))
-> Maybe (TypeExp Info VName) -> m (Maybe (TypeExp Info VName))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
astMap ASTMapper m
tv) Maybe (TypeExp Info VName)
ret
              m (Info ResRetType
   -> ExpBase Info VName
   -> ([TypeParamBase VName], [PatBase Info VName ParamType],
       Maybe (TypeExp Info VName), Info ResRetType, ExpBase Info VName))
-> m (Info ResRetType)
-> m (ExpBase Info VName
      -> ([TypeParamBase VName], [PatBase Info VName ParamType],
          Maybe (TypeExp Info VName), Info ResRetType, ExpBase Info VName))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ResRetType -> m ResRetType)
-> Info ResRetType -> m (Info ResRetType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> ResRetType -> m ResRetType
forall (m :: * -> *). ASTMapper m -> ResRetType -> m ResRetType
mapOnResRetType ASTMapper m
tv) Info ResRetType
t
              m (ExpBase Info VName
   -> ([TypeParamBase VName], [PatBase Info VName ParamType],
       Maybe (TypeExp Info VName), Info ResRetType, ExpBase Info VName))
-> m (ExpBase Info VName)
-> m ([TypeParamBase VName], [PatBase Info VName ParamType],
      Maybe (TypeExp Info VName), Info ResRetType, ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e
          )
      m (ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
-> m (ExpBase Info VName) -> m (SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
body
      m (SrcLoc -> AppExpBase Info VName)
-> m SrcLoc -> m (AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (LetWith IdentBase Info VName StructType
dest IdentBase Info VName StructType
src SliceBase Info VName
idxexps ExpBase Info VName
vexp ExpBase Info VName
body SrcLoc
loc) =
    IdentBase Info VName StructType
-> IdentBase Info VName StructType
-> SliceBase Info VName
-> ExpBase Info VName
-> ExpBase Info VName
-> SrcLoc
-> AppExpBase Info VName
forall (f :: * -> *) vn.
IdentBase f vn StructType
-> IdentBase f vn StructType
-> SliceBase f vn
-> ExpBase f vn
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
LetWith
      (IdentBase Info VName StructType
 -> IdentBase Info VName StructType
 -> SliceBase Info VName
 -> ExpBase Info VName
 -> ExpBase Info VName
 -> SrcLoc
 -> AppExpBase Info VName)
-> m (IdentBase Info VName StructType)
-> m (IdentBase Info VName StructType
      -> SliceBase Info VName
      -> ExpBase Info VName
      -> ExpBase Info VName
      -> SrcLoc
      -> AppExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m
-> IdentBase Info VName StructType
-> m (IdentBase Info VName StructType)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m
-> IdentBase Info VName StructType
-> m (IdentBase Info VName StructType)
astMap ASTMapper m
tv IdentBase Info VName StructType
dest
      m (IdentBase Info VName StructType
   -> SliceBase Info VName
   -> ExpBase Info VName
   -> ExpBase Info VName
   -> SrcLoc
   -> AppExpBase Info VName)
-> m (IdentBase Info VName StructType)
-> m (SliceBase Info VName
      -> ExpBase Info VName
      -> ExpBase Info VName
      -> SrcLoc
      -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m
-> IdentBase Info VName StructType
-> m (IdentBase Info VName StructType)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m
-> IdentBase Info VName StructType
-> m (IdentBase Info VName StructType)
astMap ASTMapper m
tv IdentBase Info VName StructType
src
      m (SliceBase Info VName
   -> ExpBase Info VName
   -> ExpBase Info VName
   -> SrcLoc
   -> AppExpBase Info VName)
-> m (SliceBase Info VName)
-> m (ExpBase Info VName
      -> ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DimIndexBase Info VName -> m (DimIndexBase Info VName))
-> SliceBase Info VName -> m (SliceBase Info VName)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ASTMapper m
-> DimIndexBase Info VName -> m (DimIndexBase Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m
-> DimIndexBase Info VName -> m (DimIndexBase Info VName)
astMap ASTMapper m
tv) SliceBase Info VName
idxexps
      m (ExpBase Info VName
   -> ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
-> m (ExpBase Info VName)
-> m (ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
vexp
      m (ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
-> m (ExpBase Info VName) -> m (SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
body
      m (SrcLoc -> AppExpBase Info VName)
-> m SrcLoc -> m (AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (BinOp (QualName VName
fname, SrcLoc
fname_loc) Info StructType
t (ExpBase Info VName
x, Info (Maybe VName)
xext) (ExpBase Info VName
y, Info (Maybe VName)
yext) SrcLoc
loc) =
    (QualName VName, SrcLoc)
-> Info StructType
-> (ExpBase Info VName, Info (Maybe VName))
-> (ExpBase Info VName, Info (Maybe VName))
-> SrcLoc
-> AppExpBase Info VName
forall (f :: * -> *) vn.
(QualName vn, SrcLoc)
-> f StructType
-> (ExpBase f vn, f (Maybe VName))
-> (ExpBase f vn, f (Maybe VName))
-> SrcLoc
-> AppExpBase f vn
BinOp
      ((QualName VName, SrcLoc)
 -> Info StructType
 -> (ExpBase Info VName, Info (Maybe VName))
 -> (ExpBase Info VName, Info (Maybe VName))
 -> SrcLoc
 -> AppExpBase Info VName)
-> m (QualName VName, SrcLoc)
-> m (Info StructType
      -> (ExpBase Info VName, Info (Maybe VName))
      -> (ExpBase Info VName, Info (Maybe VName))
      -> SrcLoc
      -> AppExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (QualName VName -> SrcLoc -> (QualName VName, SrcLoc))
-> m (QualName VName) -> m (SrcLoc -> (QualName VName, SrcLoc))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> QualName VName -> m (QualName VName)
forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv QualName VName
fname m (SrcLoc -> (QualName VName, SrcLoc))
-> m SrcLoc -> m (QualName VName, SrcLoc)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
fname_loc)
      m (Info StructType
   -> (ExpBase Info VName, Info (Maybe VName))
   -> (ExpBase Info VName, Info (Maybe VName))
   -> SrcLoc
   -> AppExpBase Info VName)
-> m (Info StructType)
-> m ((ExpBase Info VName, Info (Maybe VName))
      -> (ExpBase Info VName, Info (Maybe VName))
      -> SrcLoc
      -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StructType -> m StructType)
-> Info StructType -> m (Info StructType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t
      m ((ExpBase Info VName, Info (Maybe VName))
   -> (ExpBase Info VName, Info (Maybe VName))
   -> SrcLoc
   -> AppExpBase Info VName)
-> m (ExpBase Info VName, Info (Maybe VName))
-> m ((ExpBase Info VName, Info (Maybe VName))
      -> SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,) (ExpBase Info VName
 -> Info (Maybe VName) -> (ExpBase Info VName, Info (Maybe VName)))
-> m (ExpBase Info VName)
-> m (Info (Maybe VName)
      -> (ExpBase Info VName, Info (Maybe VName)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
x m (Info (Maybe VName) -> (ExpBase Info VName, Info (Maybe VName)))
-> m (Info (Maybe VName))
-> m (ExpBase Info VName, Info (Maybe VName))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Info (Maybe VName) -> m (Info (Maybe VName))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Info (Maybe VName)
xext)
      m ((ExpBase Info VName, Info (Maybe VName))
   -> SrcLoc -> AppExpBase Info VName)
-> m (ExpBase Info VName, Info (Maybe VName))
-> m (SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,) (ExpBase Info VName
 -> Info (Maybe VName) -> (ExpBase Info VName, Info (Maybe VName)))
-> m (ExpBase Info VName)
-> m (Info (Maybe VName)
      -> (ExpBase Info VName, Info (Maybe VName)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
y m (Info (Maybe VName) -> (ExpBase Info VName, Info (Maybe VName)))
-> m (Info (Maybe VName))
-> m (ExpBase Info VName, Info (Maybe VName))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Info (Maybe VName) -> m (Info (Maybe VName))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Info (Maybe VName)
yext)
      m (SrcLoc -> AppExpBase Info VName)
-> m SrcLoc -> m (AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Loop [VName]
sparams PatBase Info VName ParamType
mergepat ExpBase Info VName
mergeexp LoopFormBase Info VName
form ExpBase Info VName
loopbody SrcLoc
loc) =
    [VName]
-> PatBase Info VName ParamType
-> ExpBase Info VName
-> LoopFormBase Info VName
-> ExpBase Info VName
-> SrcLoc
-> AppExpBase Info VName
forall (f :: * -> *) vn.
[VName]
-> PatBase f vn ParamType
-> ExpBase f vn
-> LoopFormBase f vn
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
Loop [VName]
sparams
      (PatBase Info VName ParamType
 -> ExpBase Info VName
 -> LoopFormBase Info VName
 -> ExpBase Info VName
 -> SrcLoc
 -> AppExpBase Info VName)
-> m (PatBase Info VName ParamType)
-> m (ExpBase Info VName
      -> LoopFormBase Info VName
      -> ExpBase Info VName
      -> SrcLoc
      -> AppExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m
-> PatBase Info VName ParamType -> m (PatBase Info VName ParamType)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m
-> PatBase Info VName ParamType -> m (PatBase Info VName ParamType)
astMap ASTMapper m
tv PatBase Info VName ParamType
mergepat
      m (ExpBase Info VName
   -> LoopFormBase Info VName
   -> ExpBase Info VName
   -> SrcLoc
   -> AppExpBase Info VName)
-> m (ExpBase Info VName)
-> m (LoopFormBase Info VName
      -> ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
mergeexp
      m (LoopFormBase Info VName
   -> ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
-> m (LoopFormBase Info VName)
-> m (ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m
-> LoopFormBase Info VName -> m (LoopFormBase Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m
-> LoopFormBase Info VName -> m (LoopFormBase Info VName)
astMap ASTMapper m
tv LoopFormBase Info VName
form
      m (ExpBase Info VName -> SrcLoc -> AppExpBase Info VName)
-> m (ExpBase Info VName) -> m (SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
loopbody
      m (SrcLoc -> AppExpBase Info VName)
-> m SrcLoc -> m (AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Index ExpBase Info VName
arr SliceBase Info VName
idxexps SrcLoc
loc) =
    ExpBase Info VName
-> SliceBase Info VName -> SrcLoc -> AppExpBase Info VName
forall (f :: * -> *) vn.
ExpBase f vn -> SliceBase f vn -> SrcLoc -> AppExpBase f vn
Index (ExpBase Info VName
 -> SliceBase Info VName -> SrcLoc -> AppExpBase Info VName)
-> m (ExpBase Info VName)
-> m (SliceBase Info VName -> SrcLoc -> AppExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
arr m (SliceBase Info VName -> SrcLoc -> AppExpBase Info VName)
-> m (SliceBase Info VName) -> m (SrcLoc -> AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DimIndexBase Info VName -> m (DimIndexBase Info VName))
-> SliceBase Info VName -> m (SliceBase Info VName)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ASTMapper m
-> DimIndexBase Info VName -> m (DimIndexBase Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m
-> DimIndexBase Info VName -> m (DimIndexBase Info VName)
astMap ASTMapper m
tv) SliceBase Info VName
idxexps m (SrcLoc -> AppExpBase Info VName)
-> m SrcLoc -> m (AppExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc

instance ASTMappable (ExpBase Info VName) where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
astMap ASTMapper m
tv (Var QualName VName
name Info StructType
t SrcLoc
loc) =
    QualName VName -> Info StructType -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn.
QualName vn -> f StructType -> SrcLoc -> ExpBase f vn
Var
      (QualName VName -> Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (QualName VName)
-> m (Info StructType -> SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> QualName VName -> m (QualName VName)
forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv QualName VName
name
      m (Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (Info StructType) -> m (SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StructType -> m StructType)
-> Info StructType -> m (Info StructType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t
      m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Hole Info StructType
t SrcLoc
loc) =
    Info StructType -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn. f StructType -> SrcLoc -> ExpBase f vn
Hole (Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (Info StructType) -> m (SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StructType -> m StructType)
-> Info StructType -> m (Info StructType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
_ (Literal PrimValue
val SrcLoc
loc) =
    ExpBase Info VName -> m (ExpBase Info VName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpBase Info VName -> m (ExpBase Info VName))
-> ExpBase Info VName -> m (ExpBase Info VName)
forall a b. (a -> b) -> a -> b
$ PrimValue -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn. PrimValue -> SrcLoc -> ExpBase f vn
Literal PrimValue
val SrcLoc
loc
  astMap ASTMapper m
_ (StringLit [Word8]
vs SrcLoc
loc) =
    ExpBase Info VName -> m (ExpBase Info VName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpBase Info VName -> m (ExpBase Info VName))
-> ExpBase Info VName -> m (ExpBase Info VName)
forall a b. (a -> b) -> a -> b
$ [Word8] -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn. [Word8] -> SrcLoc -> ExpBase f vn
StringLit [Word8]
vs SrcLoc
loc
  astMap ASTMapper m
tv (IntLit Integer
val Info StructType
t SrcLoc
loc) =
    Integer -> Info StructType -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn.
Integer -> f StructType -> SrcLoc -> ExpBase f vn
IntLit Integer
val (Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (Info StructType) -> m (SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StructType -> m StructType)
-> Info StructType -> m (Info StructType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (FloatLit Double
val Info StructType
t SrcLoc
loc) =
    Double -> Info StructType -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn.
Double -> f StructType -> SrcLoc -> ExpBase f vn
FloatLit Double
val (Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (Info StructType) -> m (SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StructType -> m StructType)
-> Info StructType -> m (Info StructType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Parens ExpBase Info VName
e SrcLoc
loc) =
    ExpBase Info VName -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn. ExpBase f vn -> SrcLoc -> ExpBase f vn
Parens (ExpBase Info VName -> SrcLoc -> ExpBase Info VName)
-> m (ExpBase Info VName) -> m (SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (QualParens (QualName VName
name, SrcLoc
nameloc) ExpBase Info VName
e SrcLoc
loc) =
    (QualName VName, SrcLoc)
-> ExpBase Info VName -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn.
(QualName vn, SrcLoc) -> ExpBase f vn -> SrcLoc -> ExpBase f vn
QualParens
      ((QualName VName, SrcLoc)
 -> ExpBase Info VName -> SrcLoc -> ExpBase Info VName)
-> m (QualName VName, SrcLoc)
-> m (ExpBase Info VName -> SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (QualName VName -> SrcLoc -> (QualName VName, SrcLoc))
-> m (QualName VName) -> m (SrcLoc -> (QualName VName, SrcLoc))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> QualName VName -> m (QualName VName)
forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv QualName VName
name m (SrcLoc -> (QualName VName, SrcLoc))
-> m SrcLoc -> m (QualName VName, SrcLoc)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
nameloc)
      m (ExpBase Info VName -> SrcLoc -> ExpBase Info VName)
-> m (ExpBase Info VName) -> m (SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e
      m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TupLit [ExpBase Info VName]
els SrcLoc
loc) =
    [ExpBase Info VName] -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn. [ExpBase f vn] -> SrcLoc -> ExpBase f vn
TupLit ([ExpBase Info VName] -> SrcLoc -> ExpBase Info VName)
-> m [ExpBase Info VName] -> m (SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExpBase Info VName -> m (ExpBase Info VName))
-> [ExpBase Info VName] -> m [ExpBase Info VName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) [ExpBase Info VName]
els m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (RecordLit [FieldBase Info VName]
fields SrcLoc
loc) =
    [FieldBase Info VName] -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn. [FieldBase f vn] -> SrcLoc -> ExpBase f vn
RecordLit ([FieldBase Info VName] -> SrcLoc -> ExpBase Info VName)
-> m [FieldBase Info VName] -> m (SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> [FieldBase Info VName] -> m [FieldBase Info VName]
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> [FieldBase Info VName] -> m [FieldBase Info VName]
astMap ASTMapper m
tv [FieldBase Info VName]
fields m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (ArrayLit [ExpBase Info VName]
els Info StructType
t SrcLoc
loc) =
    [ExpBase Info VName]
-> Info StructType -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn.
[ExpBase f vn] -> f StructType -> SrcLoc -> ExpBase f vn
ArrayLit ([ExpBase Info VName]
 -> Info StructType -> SrcLoc -> ExpBase Info VName)
-> m [ExpBase Info VName]
-> m (Info StructType -> SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExpBase Info VName -> m (ExpBase Info VName))
-> [ExpBase Info VName] -> m [ExpBase Info VName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) [ExpBase Info VName]
els m (Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (Info StructType) -> m (SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StructType -> m StructType)
-> Info StructType -> m (Info StructType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Ascript ExpBase Info VName
e TypeExp Info VName
tdecl SrcLoc
loc) =
    ExpBase Info VName
-> TypeExp Info VName -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn.
ExpBase f vn -> TypeExp f vn -> SrcLoc -> ExpBase f vn
Ascript (ExpBase Info VName
 -> TypeExp Info VName -> SrcLoc -> ExpBase Info VName)
-> m (ExpBase Info VName)
-> m (TypeExp Info VName -> SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e m (TypeExp Info VName -> SrcLoc -> ExpBase Info VName)
-> m (TypeExp Info VName) -> m (SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
astMap ASTMapper m
tv TypeExp Info VName
tdecl m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Coerce ExpBase Info VName
e TypeExp Info VName
tdecl Info StructType
t SrcLoc
loc) =
    ExpBase Info VName
-> TypeExp Info VName
-> Info StructType
-> SrcLoc
-> ExpBase Info VName
forall (f :: * -> *) vn.
ExpBase f vn
-> TypeExp f vn -> f StructType -> SrcLoc -> ExpBase f vn
Coerce (ExpBase Info VName
 -> TypeExp Info VName
 -> Info StructType
 -> SrcLoc
 -> ExpBase Info VName)
-> m (ExpBase Info VName)
-> m (TypeExp Info VName
      -> Info StructType -> SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e m (TypeExp Info VName
   -> Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (TypeExp Info VName)
-> m (Info StructType -> SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
astMap ASTMapper m
tv TypeExp Info VName
tdecl m (Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (Info StructType) -> m (SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StructType -> m StructType)
-> Info StructType -> m (Info StructType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Negate ExpBase Info VName
x SrcLoc
loc) =
    ExpBase Info VName -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn. ExpBase f vn -> SrcLoc -> ExpBase f vn
Negate (ExpBase Info VName -> SrcLoc -> ExpBase Info VName)
-> m (ExpBase Info VName) -> m (SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
x m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Not ExpBase Info VName
x SrcLoc
loc) =
    ExpBase Info VName -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn. ExpBase f vn -> SrcLoc -> ExpBase f vn
Not (ExpBase Info VName -> SrcLoc -> ExpBase Info VName)
-> m (ExpBase Info VName) -> m (SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
x m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Update ExpBase Info VName
src SliceBase Info VName
slice ExpBase Info VName
v SrcLoc
loc) =
    ExpBase Info VName
-> SliceBase Info VName
-> ExpBase Info VName
-> SrcLoc
-> ExpBase Info VName
forall (f :: * -> *) vn.
ExpBase f vn
-> SliceBase f vn -> ExpBase f vn -> SrcLoc -> ExpBase f vn
Update
      (ExpBase Info VName
 -> SliceBase Info VName
 -> ExpBase Info VName
 -> SrcLoc
 -> ExpBase Info VName)
-> m (ExpBase Info VName)
-> m (SliceBase Info VName
      -> ExpBase Info VName -> SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
src
      m (SliceBase Info VName
   -> ExpBase Info VName -> SrcLoc -> ExpBase Info VName)
-> m (SliceBase Info VName)
-> m (ExpBase Info VName -> SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DimIndexBase Info VName -> m (DimIndexBase Info VName))
-> SliceBase Info VName -> m (SliceBase Info VName)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ASTMapper m
-> DimIndexBase Info VName -> m (DimIndexBase Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m
-> DimIndexBase Info VName -> m (DimIndexBase Info VName)
astMap ASTMapper m
tv) SliceBase Info VName
slice
      m (ExpBase Info VName -> SrcLoc -> ExpBase Info VName)
-> m (ExpBase Info VName) -> m (SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
v
      m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (RecordUpdate ExpBase Info VName
src [Name]
fs ExpBase Info VName
v (Info StructType
t) SrcLoc
loc) =
    ExpBase Info VName
-> [Name]
-> ExpBase Info VName
-> Info StructType
-> SrcLoc
-> ExpBase Info VName
forall (f :: * -> *) vn.
ExpBase f vn
-> [Name] -> ExpBase f vn -> f StructType -> SrcLoc -> ExpBase f vn
RecordUpdate
      (ExpBase Info VName
 -> [Name]
 -> ExpBase Info VName
 -> Info StructType
 -> SrcLoc
 -> ExpBase Info VName)
-> m (ExpBase Info VName)
-> m ([Name]
      -> ExpBase Info VName
      -> Info StructType
      -> SrcLoc
      -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
src
      m ([Name]
   -> ExpBase Info VName
   -> Info StructType
   -> SrcLoc
   -> ExpBase Info VName)
-> m [Name]
-> m (ExpBase Info VName
      -> Info StructType -> SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Name] -> m [Name]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Name]
fs
      m (ExpBase Info VName
   -> Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (ExpBase Info VName)
-> m (Info StructType -> SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
v
      m (Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (Info StructType) -> m (SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StructType -> Info StructType
forall a. a -> Info a
Info (StructType -> Info StructType)
-> m StructType -> m (Info StructType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv StructType
t)
      m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Project Name
field ExpBase Info VName
e Info StructType
t SrcLoc
loc) =
    Name
-> ExpBase Info VName
-> Info StructType
-> SrcLoc
-> ExpBase Info VName
forall (f :: * -> *) vn.
Name -> ExpBase f vn -> f StructType -> SrcLoc -> ExpBase f vn
Project Name
field (ExpBase Info VName
 -> Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (ExpBase Info VName)
-> m (Info StructType -> SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e m (Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (Info StructType) -> m (SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StructType -> m StructType)
-> Info StructType -> m (Info StructType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Assert ExpBase Info VName
e1 ExpBase Info VName
e2 Info Text
desc SrcLoc
loc) =
    ExpBase Info VName
-> ExpBase Info VName -> Info Text -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn.
ExpBase f vn -> ExpBase f vn -> f Text -> SrcLoc -> ExpBase f vn
Assert (ExpBase Info VName
 -> ExpBase Info VName -> Info Text -> SrcLoc -> ExpBase Info VName)
-> m (ExpBase Info VName)
-> m (ExpBase Info VName
      -> Info Text -> SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e1 m (ExpBase Info VName -> Info Text -> SrcLoc -> ExpBase Info VName)
-> m (ExpBase Info VName)
-> m (Info Text -> SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e2 m (Info Text -> SrcLoc -> ExpBase Info VName)
-> m (Info Text) -> m (SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Info Text -> m (Info Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Info Text
desc m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Lambda [PatBase Info VName ParamType]
params ExpBase Info VName
body Maybe (TypeExp Info VName)
ret Info ResRetType
t SrcLoc
loc) =
    [PatBase Info VName ParamType]
-> ExpBase Info VName
-> Maybe (TypeExp Info VName)
-> Info ResRetType
-> SrcLoc
-> ExpBase Info VName
forall (f :: * -> *) vn.
[PatBase f vn ParamType]
-> ExpBase f vn
-> Maybe (TypeExp f vn)
-> f ResRetType
-> SrcLoc
-> ExpBase f vn
Lambda
      ([PatBase Info VName ParamType]
 -> ExpBase Info VName
 -> Maybe (TypeExp Info VName)
 -> Info ResRetType
 -> SrcLoc
 -> ExpBase Info VName)
-> m [PatBase Info VName ParamType]
-> m (ExpBase Info VName
      -> Maybe (TypeExp Info VName)
      -> Info ResRetType
      -> SrcLoc
      -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PatBase Info VName ParamType -> m (PatBase Info VName ParamType))
-> [PatBase Info VName ParamType]
-> m [PatBase Info VName ParamType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ASTMapper m
-> PatBase Info VName ParamType -> m (PatBase Info VName ParamType)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m
-> PatBase Info VName ParamType -> m (PatBase Info VName ParamType)
astMap ASTMapper m
tv) [PatBase Info VName ParamType]
params
      m (ExpBase Info VName
   -> Maybe (TypeExp Info VName)
   -> Info ResRetType
   -> SrcLoc
   -> ExpBase Info VName)
-> m (ExpBase Info VName)
-> m (Maybe (TypeExp Info VName)
      -> Info ResRetType -> SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
body
      m (Maybe (TypeExp Info VName)
   -> Info ResRetType -> SrcLoc -> ExpBase Info VName)
-> m (Maybe (TypeExp Info VName))
-> m (Info ResRetType -> SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TypeExp Info VName -> m (TypeExp Info VName))
-> Maybe (TypeExp Info VName) -> m (Maybe (TypeExp Info VName))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
astMap ASTMapper m
tv) Maybe (TypeExp Info VName)
ret
      m (Info ResRetType -> SrcLoc -> ExpBase Info VName)
-> m (Info ResRetType) -> m (SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ResRetType -> m ResRetType)
-> Info ResRetType -> m (Info ResRetType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> ResRetType -> m ResRetType
forall (m :: * -> *). ASTMapper m -> ResRetType -> m ResRetType
mapOnResRetType ASTMapper m
tv) Info ResRetType
t
      m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (OpSection QualName VName
name Info StructType
t SrcLoc
loc) =
    QualName VName -> Info StructType -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn.
QualName vn -> f StructType -> SrcLoc -> ExpBase f vn
OpSection
      (QualName VName -> Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (QualName VName)
-> m (Info StructType -> SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> QualName VName -> m (QualName VName)
forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv QualName VName
name
      m (Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (Info StructType) -> m (SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StructType -> m StructType)
-> Info StructType -> m (Info StructType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t
      m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (OpSectionLeft QualName VName
name Info StructType
t ExpBase Info VName
arg (Info (PName
pa, ParamType
t1a, Maybe VName
argext), Info (PName
pb, ParamType
t1b)) (Info ResRetType
ret, Info [VName]
retext) SrcLoc
loc) =
    QualName VName
-> Info StructType
-> ExpBase Info VName
-> (Info (PName, ParamType, Maybe VName), Info (PName, ParamType))
-> (Info ResRetType, Info [VName])
-> SrcLoc
-> ExpBase Info VName
forall (f :: * -> *) vn.
QualName vn
-> f StructType
-> ExpBase f vn
-> (f (PName, ParamType, Maybe VName), f (PName, ParamType))
-> (f ResRetType, f [VName])
-> SrcLoc
-> ExpBase f vn
OpSectionLeft
      (QualName VName
 -> Info StructType
 -> ExpBase Info VName
 -> (Info (PName, ParamType, Maybe VName), Info (PName, ParamType))
 -> (Info ResRetType, Info [VName])
 -> SrcLoc
 -> ExpBase Info VName)
-> m (QualName VName)
-> m (Info StructType
      -> ExpBase Info VName
      -> (Info (PName, ParamType, Maybe VName), Info (PName, ParamType))
      -> (Info ResRetType, Info [VName])
      -> SrcLoc
      -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> QualName VName -> m (QualName VName)
forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv QualName VName
name
      m (Info StructType
   -> ExpBase Info VName
   -> (Info (PName, ParamType, Maybe VName), Info (PName, ParamType))
   -> (Info ResRetType, Info [VName])
   -> SrcLoc
   -> ExpBase Info VName)
-> m (Info StructType)
-> m (ExpBase Info VName
      -> (Info (PName, ParamType, Maybe VName), Info (PName, ParamType))
      -> (Info ResRetType, Info [VName])
      -> SrcLoc
      -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StructType -> m StructType)
-> Info StructType -> m (Info StructType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t
      m (ExpBase Info VName
   -> (Info (PName, ParamType, Maybe VName), Info (PName, ParamType))
   -> (Info ResRetType, Info [VName])
   -> SrcLoc
   -> ExpBase Info VName)
-> m (ExpBase Info VName)
-> m ((Info (PName, ParamType, Maybe VName),
       Info (PName, ParamType))
      -> (Info ResRetType, Info [VName]) -> SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
arg
      m ((Info (PName, ParamType, Maybe VName), Info (PName, ParamType))
   -> (Info ResRetType, Info [VName]) -> SrcLoc -> ExpBase Info VName)
-> m (Info (PName, ParamType, Maybe VName),
      Info (PName, ParamType))
-> m ((Info ResRetType, Info [VName])
      -> SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( (,)
              (Info (PName, ParamType, Maybe VName)
 -> Info (PName, ParamType)
 -> (Info (PName, ParamType, Maybe VName), Info (PName, ParamType)))
-> m (Info (PName, ParamType, Maybe VName))
-> m (Info (PName, ParamType)
      -> (Info (PName, ParamType, Maybe VName), Info (PName, ParamType)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PName, ParamType, Maybe VName)
-> Info (PName, ParamType, Maybe VName)
forall a. a -> Info a
Info ((PName, ParamType, Maybe VName)
 -> Info (PName, ParamType, Maybe VName))
-> m (PName, ParamType, Maybe VName)
-> m (Info (PName, ParamType, Maybe VName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PName
pa,,) (ParamType -> Maybe VName -> (PName, ParamType, Maybe VName))
-> m ParamType
-> m (Maybe VName -> (PName, ParamType, Maybe VName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ParamType -> m ParamType
forall (m :: * -> *). ASTMapper m -> ParamType -> m ParamType
mapOnParamType ASTMapper m
tv ParamType
t1a m (Maybe VName -> (PName, ParamType, Maybe VName))
-> m (Maybe VName) -> m (PName, ParamType, Maybe VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe VName -> m (Maybe VName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VName
argext))
              m (Info (PName, ParamType)
   -> (Info (PName, ParamType, Maybe VName), Info (PName, ParamType)))
-> m (Info (PName, ParamType))
-> m (Info (PName, ParamType, Maybe VName),
      Info (PName, ParamType))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((PName, ParamType) -> Info (PName, ParamType)
forall a. a -> Info a
Info ((PName, ParamType) -> Info (PName, ParamType))
-> m (PName, ParamType) -> m (Info (PName, ParamType))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PName
pb,) (ParamType -> (PName, ParamType))
-> m ParamType -> m (PName, ParamType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ParamType -> m ParamType
forall (m :: * -> *). ASTMapper m -> ParamType -> m ParamType
mapOnParamType ASTMapper m
tv ParamType
t1b))
          )
      m ((Info ResRetType, Info [VName]) -> SrcLoc -> ExpBase Info VName)
-> m (Info ResRetType, Info [VName])
-> m (SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,) (Info ResRetType
 -> Info [VName] -> (Info ResRetType, Info [VName]))
-> m (Info ResRetType)
-> m (Info [VName] -> (Info ResRetType, Info [VName]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ResRetType -> m ResRetType)
-> Info ResRetType -> m (Info ResRetType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> ResRetType -> m ResRetType
forall (m :: * -> *). ASTMapper m -> ResRetType -> m ResRetType
mapOnResRetType ASTMapper m
tv) Info ResRetType
ret m (Info [VName] -> (Info ResRetType, Info [VName]))
-> m (Info [VName]) -> m (Info ResRetType, Info [VName])
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Info [VName] -> m (Info [VName])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Info [VName]
retext)
      m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (OpSectionRight QualName VName
name Info StructType
t ExpBase Info VName
arg (Info (PName
pa, ParamType
t1a), Info (PName
pb, ParamType
t1b, Maybe VName
argext)) Info ResRetType
t2 SrcLoc
loc) =
    QualName VName
-> Info StructType
-> ExpBase Info VName
-> (Info (PName, ParamType), Info (PName, ParamType, Maybe VName))
-> Info ResRetType
-> SrcLoc
-> ExpBase Info VName
forall (f :: * -> *) vn.
QualName vn
-> f StructType
-> ExpBase f vn
-> (f (PName, ParamType), f (PName, ParamType, Maybe VName))
-> f ResRetType
-> SrcLoc
-> ExpBase f vn
OpSectionRight
      (QualName VName
 -> Info StructType
 -> ExpBase Info VName
 -> (Info (PName, ParamType), Info (PName, ParamType, Maybe VName))
 -> Info ResRetType
 -> SrcLoc
 -> ExpBase Info VName)
-> m (QualName VName)
-> m (Info StructType
      -> ExpBase Info VName
      -> (Info (PName, ParamType), Info (PName, ParamType, Maybe VName))
      -> Info ResRetType
      -> SrcLoc
      -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> QualName VName -> m (QualName VName)
forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv QualName VName
name
      m (Info StructType
   -> ExpBase Info VName
   -> (Info (PName, ParamType), Info (PName, ParamType, Maybe VName))
   -> Info ResRetType
   -> SrcLoc
   -> ExpBase Info VName)
-> m (Info StructType)
-> m (ExpBase Info VName
      -> (Info (PName, ParamType), Info (PName, ParamType, Maybe VName))
      -> Info ResRetType
      -> SrcLoc
      -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StructType -> m StructType)
-> Info StructType -> m (Info StructType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t
      m (ExpBase Info VName
   -> (Info (PName, ParamType), Info (PName, ParamType, Maybe VName))
   -> Info ResRetType
   -> SrcLoc
   -> ExpBase Info VName)
-> m (ExpBase Info VName)
-> m ((Info (PName, ParamType),
       Info (PName, ParamType, Maybe VName))
      -> Info ResRetType -> SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
arg
      m ((Info (PName, ParamType), Info (PName, ParamType, Maybe VName))
   -> Info ResRetType -> SrcLoc -> ExpBase Info VName)
-> m (Info (PName, ParamType),
      Info (PName, ParamType, Maybe VName))
-> m (Info ResRetType -> SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( (,)
              (Info (PName, ParamType)
 -> Info (PName, ParamType, Maybe VName)
 -> (Info (PName, ParamType), Info (PName, ParamType, Maybe VName)))
-> m (Info (PName, ParamType))
-> m (Info (PName, ParamType, Maybe VName)
      -> (Info (PName, ParamType), Info (PName, ParamType, Maybe VName)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PName, ParamType) -> Info (PName, ParamType)
forall a. a -> Info a
Info ((PName, ParamType) -> Info (PName, ParamType))
-> m (PName, ParamType) -> m (Info (PName, ParamType))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PName
pa,) (ParamType -> (PName, ParamType))
-> m ParamType -> m (PName, ParamType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ParamType -> m ParamType
forall (m :: * -> *). ASTMapper m -> ParamType -> m ParamType
mapOnParamType ASTMapper m
tv ParamType
t1a))
              m (Info (PName, ParamType, Maybe VName)
   -> (Info (PName, ParamType), Info (PName, ParamType, Maybe VName)))
-> m (Info (PName, ParamType, Maybe VName))
-> m (Info (PName, ParamType),
      Info (PName, ParamType, Maybe VName))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((PName, ParamType, Maybe VName)
-> Info (PName, ParamType, Maybe VName)
forall a. a -> Info a
Info ((PName, ParamType, Maybe VName)
 -> Info (PName, ParamType, Maybe VName))
-> m (PName, ParamType, Maybe VName)
-> m (Info (PName, ParamType, Maybe VName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PName
pb,,) (ParamType -> Maybe VName -> (PName, ParamType, Maybe VName))
-> m ParamType
-> m (Maybe VName -> (PName, ParamType, Maybe VName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ParamType -> m ParamType
forall (m :: * -> *). ASTMapper m -> ParamType -> m ParamType
mapOnParamType ASTMapper m
tv ParamType
t1b m (Maybe VName -> (PName, ParamType, Maybe VName))
-> m (Maybe VName) -> m (PName, ParamType, Maybe VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe VName -> m (Maybe VName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VName
argext))
          )
      m (Info ResRetType -> SrcLoc -> ExpBase Info VName)
-> m (Info ResRetType) -> m (SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ResRetType -> m ResRetType)
-> Info ResRetType -> m (Info ResRetType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> ResRetType -> m ResRetType
forall (m :: * -> *). ASTMapper m -> ResRetType -> m ResRetType
mapOnResRetType ASTMapper m
tv) Info ResRetType
t2
      m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (ProjectSection [Name]
fields Info StructType
t SrcLoc
loc) =
    [Name] -> Info StructType -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn.
[Name] -> f StructType -> SrcLoc -> ExpBase f vn
ProjectSection [Name]
fields (Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (Info StructType) -> m (SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StructType -> m StructType)
-> Info StructType -> m (Info StructType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (IndexSection SliceBase Info VName
idxs Info StructType
t SrcLoc
loc) =
    SliceBase Info VName
-> Info StructType -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn.
SliceBase f vn -> f StructType -> SrcLoc -> ExpBase f vn
IndexSection
      (SliceBase Info VName
 -> Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (SliceBase Info VName)
-> m (Info StructType -> SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DimIndexBase Info VName -> m (DimIndexBase Info VName))
-> SliceBase Info VName -> m (SliceBase Info VName)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ASTMapper m
-> DimIndexBase Info VName -> m (DimIndexBase Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m
-> DimIndexBase Info VName -> m (DimIndexBase Info VName)
astMap ASTMapper m
tv) SliceBase Info VName
idxs
      m (Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (Info StructType) -> m (SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StructType -> m StructType)
-> Info StructType -> m (Info StructType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t
      m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Constr Name
name [ExpBase Info VName]
es Info StructType
t SrcLoc
loc) =
    Name
-> [ExpBase Info VName]
-> Info StructType
-> SrcLoc
-> ExpBase Info VName
forall (f :: * -> *) vn.
Name -> [ExpBase f vn] -> f StructType -> SrcLoc -> ExpBase f vn
Constr Name
name ([ExpBase Info VName]
 -> Info StructType -> SrcLoc -> ExpBase Info VName)
-> m [ExpBase Info VName]
-> m (Info StructType -> SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExpBase Info VName -> m (ExpBase Info VName))
-> [ExpBase Info VName] -> m [ExpBase Info VName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) [ExpBase Info VName]
es m (Info StructType -> SrcLoc -> ExpBase Info VName)
-> m (Info StructType) -> m (SrcLoc -> ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StructType -> m StructType)
-> Info StructType -> m (Info StructType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Attr AttrInfo VName
attr ExpBase Info VName
e SrcLoc
loc) =
    AttrInfo VName
-> ExpBase Info VName -> SrcLoc -> ExpBase Info VName
forall (f :: * -> *) vn.
AttrInfo vn -> ExpBase f vn -> SrcLoc -> ExpBase f vn
Attr AttrInfo VName
attr (ExpBase Info VName -> SrcLoc -> ExpBase Info VName)
-> m (ExpBase Info VName) -> m (SrcLoc -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e m (SrcLoc -> ExpBase Info VName)
-> m SrcLoc -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (AppExp AppExpBase Info VName
e Info AppRes
res) =
    AppExpBase Info VName -> Info AppRes -> ExpBase Info VName
forall (f :: * -> *) vn.
AppExpBase f vn -> f AppRes -> ExpBase f vn
AppExp (AppExpBase Info VName -> Info AppRes -> ExpBase Info VName)
-> m (AppExpBase Info VName)
-> m (Info AppRes -> ExpBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> AppExpBase Info VName -> m (AppExpBase Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> AppExpBase Info VName -> m (AppExpBase Info VName)
astMap ASTMapper m
tv AppExpBase Info VName
e m (Info AppRes -> ExpBase Info VName)
-> m (Info AppRes) -> m (ExpBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> Info AppRes -> m (Info AppRes)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> Info AppRes -> m (Info AppRes)
astMap ASTMapper m
tv Info AppRes
res

instance ASTMappable (LoopFormBase Info VName) where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m
-> LoopFormBase Info VName -> m (LoopFormBase Info VName)
astMap ASTMapper m
tv (For IdentBase Info VName StructType
i ExpBase Info VName
bound) = IdentBase Info VName StructType
-> ExpBase Info VName -> LoopFormBase Info VName
forall (f :: * -> *) vn.
IdentBase f vn StructType -> ExpBase f vn -> LoopFormBase f vn
For (IdentBase Info VName StructType
 -> ExpBase Info VName -> LoopFormBase Info VName)
-> m (IdentBase Info VName StructType)
-> m (ExpBase Info VName -> LoopFormBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m
-> IdentBase Info VName StructType
-> m (IdentBase Info VName StructType)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m
-> IdentBase Info VName StructType
-> m (IdentBase Info VName StructType)
astMap ASTMapper m
tv IdentBase Info VName StructType
i m (ExpBase Info VName -> LoopFormBase Info VName)
-> m (ExpBase Info VName) -> m (LoopFormBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
bound
  astMap ASTMapper m
tv (ForIn PatBase Info VName StructType
pat ExpBase Info VName
e) = PatBase Info VName StructType
-> ExpBase Info VName -> LoopFormBase Info VName
forall (f :: * -> *) vn.
PatBase f vn StructType -> ExpBase f vn -> LoopFormBase f vn
ForIn (PatBase Info VName StructType
 -> ExpBase Info VName -> LoopFormBase Info VName)
-> m (PatBase Info VName StructType)
-> m (ExpBase Info VName -> LoopFormBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m
-> PatBase Info VName StructType
-> m (PatBase Info VName StructType)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m
-> PatBase Info VName StructType
-> m (PatBase Info VName StructType)
astMap ASTMapper m
tv PatBase Info VName StructType
pat m (ExpBase Info VName -> LoopFormBase Info VName)
-> m (ExpBase Info VName) -> m (LoopFormBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e
  astMap ASTMapper m
tv (While ExpBase Info VName
e) = ExpBase Info VName -> LoopFormBase Info VName
forall (f :: * -> *) vn. ExpBase f vn -> LoopFormBase f vn
While (ExpBase Info VName -> LoopFormBase Info VName)
-> m (ExpBase Info VName) -> m (LoopFormBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e

instance ASTMappable (TypeExp Info VName) where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
astMap ASTMapper m
tv (TEVar QualName VName
qn SrcLoc
loc) =
    QualName VName -> SrcLoc -> TypeExp Info VName
forall (f :: * -> *) vn. QualName vn -> SrcLoc -> TypeExp f vn
TEVar (QualName VName -> SrcLoc -> TypeExp Info VName)
-> m (QualName VName) -> m (SrcLoc -> TypeExp Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> QualName VName -> m (QualName VName)
forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv QualName VName
qn m (SrcLoc -> TypeExp Info VName)
-> m SrcLoc -> m (TypeExp Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TEParens TypeExp Info VName
te SrcLoc
loc) =
    TypeExp Info VName -> SrcLoc -> TypeExp Info VName
forall (f :: * -> *) vn. TypeExp f vn -> SrcLoc -> TypeExp f vn
TEParens (TypeExp Info VName -> SrcLoc -> TypeExp Info VName)
-> m (TypeExp Info VName) -> m (SrcLoc -> TypeExp Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
astMap ASTMapper m
tv TypeExp Info VName
te m (SrcLoc -> TypeExp Info VName)
-> m SrcLoc -> m (TypeExp Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TETuple [TypeExp Info VName]
ts SrcLoc
loc) =
    [TypeExp Info VName] -> SrcLoc -> TypeExp Info VName
forall (f :: * -> *) vn. [TypeExp f vn] -> SrcLoc -> TypeExp f vn
TETuple ([TypeExp Info VName] -> SrcLoc -> TypeExp Info VName)
-> m [TypeExp Info VName] -> m (SrcLoc -> TypeExp Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeExp Info VName -> m (TypeExp Info VName))
-> [TypeExp Info VName] -> m [TypeExp Info VName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
astMap ASTMapper m
tv) [TypeExp Info VName]
ts m (SrcLoc -> TypeExp Info VName)
-> m SrcLoc -> m (TypeExp Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TERecord [(Name, TypeExp Info VName)]
ts SrcLoc
loc) =
    [(Name, TypeExp Info VName)] -> SrcLoc -> TypeExp Info VName
forall (f :: * -> *) vn.
[(Name, TypeExp f vn)] -> SrcLoc -> TypeExp f vn
TERecord ([(Name, TypeExp Info VName)] -> SrcLoc -> TypeExp Info VName)
-> m [(Name, TypeExp Info VName)]
-> m (SrcLoc -> TypeExp Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, TypeExp Info VName) -> m (Name, TypeExp Info VName))
-> [(Name, TypeExp Info VName)] -> m [(Name, TypeExp Info VName)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((TypeExp Info VName -> m (TypeExp Info VName))
-> (Name, TypeExp Info VName) -> m (Name, TypeExp Info VName)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (Name, a) -> f (Name, b)
traverse ((TypeExp Info VName -> m (TypeExp Info VName))
 -> (Name, TypeExp Info VName) -> m (Name, TypeExp Info VName))
-> (TypeExp Info VName -> m (TypeExp Info VName))
-> (Name, TypeExp Info VName)
-> m (Name, TypeExp Info VName)
forall a b. (a -> b) -> a -> b
$ ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
astMap ASTMapper m
tv) [(Name, TypeExp Info VName)]
ts m (SrcLoc -> TypeExp Info VName)
-> m SrcLoc -> m (TypeExp Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TEArray SizeExp Info VName
te TypeExp Info VName
dim SrcLoc
loc) =
    SizeExp Info VName
-> TypeExp Info VName -> SrcLoc -> TypeExp Info VName
forall (f :: * -> *) vn.
SizeExp f vn -> TypeExp f vn -> SrcLoc -> TypeExp f vn
TEArray (SizeExp Info VName
 -> TypeExp Info VName -> SrcLoc -> TypeExp Info VName)
-> m (SizeExp Info VName)
-> m (TypeExp Info VName -> SrcLoc -> TypeExp Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> SizeExp Info VName -> m (SizeExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> SizeExp Info VName -> m (SizeExp Info VName)
astMap ASTMapper m
tv SizeExp Info VName
te m (TypeExp Info VName -> SrcLoc -> TypeExp Info VName)
-> m (TypeExp Info VName) -> m (SrcLoc -> TypeExp Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
astMap ASTMapper m
tv TypeExp Info VName
dim m (SrcLoc -> TypeExp Info VName)
-> m SrcLoc -> m (TypeExp Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TEUnique TypeExp Info VName
t SrcLoc
loc) =
    TypeExp Info VName -> SrcLoc -> TypeExp Info VName
forall (f :: * -> *) vn. TypeExp f vn -> SrcLoc -> TypeExp f vn
TEUnique (TypeExp Info VName -> SrcLoc -> TypeExp Info VName)
-> m (TypeExp Info VName) -> m (SrcLoc -> TypeExp Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
astMap ASTMapper m
tv TypeExp Info VName
t m (SrcLoc -> TypeExp Info VName)
-> m SrcLoc -> m (TypeExp Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TEApply TypeExp Info VName
t1 TypeArgExp Info VName
t2 SrcLoc
loc) =
    TypeExp Info VName
-> TypeArgExp Info VName -> SrcLoc -> TypeExp Info VName
forall (f :: * -> *) vn.
TypeExp f vn -> TypeArgExp f vn -> SrcLoc -> TypeExp f vn
TEApply (TypeExp Info VName
 -> TypeArgExp Info VName -> SrcLoc -> TypeExp Info VName)
-> m (TypeExp Info VName)
-> m (TypeArgExp Info VName -> SrcLoc -> TypeExp Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
astMap ASTMapper m
tv TypeExp Info VName
t1 m (TypeArgExp Info VName -> SrcLoc -> TypeExp Info VName)
-> m (TypeArgExp Info VName) -> m (SrcLoc -> TypeExp Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> TypeArgExp Info VName -> m (TypeArgExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeArgExp Info VName -> m (TypeArgExp Info VName)
astMap ASTMapper m
tv TypeArgExp Info VName
t2 m (SrcLoc -> TypeExp Info VName)
-> m SrcLoc -> m (TypeExp Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TEArrow Maybe VName
v TypeExp Info VName
t1 TypeExp Info VName
t2 SrcLoc
loc) =
    Maybe VName
-> TypeExp Info VName
-> TypeExp Info VName
-> SrcLoc
-> TypeExp Info VName
forall (f :: * -> *) vn.
Maybe vn -> TypeExp f vn -> TypeExp f vn -> SrcLoc -> TypeExp f vn
TEArrow Maybe VName
v (TypeExp Info VName
 -> TypeExp Info VName -> SrcLoc -> TypeExp Info VName)
-> m (TypeExp Info VName)
-> m (TypeExp Info VName -> SrcLoc -> TypeExp Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
astMap ASTMapper m
tv TypeExp Info VName
t1 m (TypeExp Info VName -> SrcLoc -> TypeExp Info VName)
-> m (TypeExp Info VName) -> m (SrcLoc -> TypeExp Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
astMap ASTMapper m
tv TypeExp Info VName
t2 m (SrcLoc -> TypeExp Info VName)
-> m SrcLoc -> m (TypeExp Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TESum [(Name, [TypeExp Info VName])]
cs SrcLoc
loc) =
    [(Name, [TypeExp Info VName])] -> SrcLoc -> TypeExp Info VName
forall (f :: * -> *) vn.
[(Name, [TypeExp f vn])] -> SrcLoc -> TypeExp f vn
TESum ([(Name, [TypeExp Info VName])] -> SrcLoc -> TypeExp Info VName)
-> m [(Name, [TypeExp Info VName])]
-> m (SrcLoc -> TypeExp Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, [TypeExp Info VName]) -> m (Name, [TypeExp Info VName]))
-> [(Name, [TypeExp Info VName])]
-> m [(Name, [TypeExp Info VName])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (([TypeExp Info VName] -> m [TypeExp Info VName])
-> (Name, [TypeExp Info VName]) -> m (Name, [TypeExp Info VName])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (Name, a) -> f (Name, b)
traverse (([TypeExp Info VName] -> m [TypeExp Info VName])
 -> (Name, [TypeExp Info VName]) -> m (Name, [TypeExp Info VName]))
-> ([TypeExp Info VName] -> m [TypeExp Info VName])
-> (Name, [TypeExp Info VName])
-> m (Name, [TypeExp Info VName])
forall a b. (a -> b) -> a -> b
$ ASTMapper m -> [TypeExp Info VName] -> m [TypeExp Info VName]
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> [TypeExp Info VName] -> m [TypeExp Info VName]
astMap ASTMapper m
tv) [(Name, [TypeExp Info VName])]
cs m (SrcLoc -> TypeExp Info VName)
-> m SrcLoc -> m (TypeExp Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TEDim [VName]
dims TypeExp Info VName
t SrcLoc
loc) =
    [VName] -> TypeExp Info VName -> SrcLoc -> TypeExp Info VName
forall (f :: * -> *) vn.
[vn] -> TypeExp f vn -> SrcLoc -> TypeExp f vn
TEDim [VName]
dims (TypeExp Info VName -> SrcLoc -> TypeExp Info VName)
-> m (TypeExp Info VName) -> m (SrcLoc -> TypeExp Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
astMap ASTMapper m
tv TypeExp Info VName
t m (SrcLoc -> TypeExp Info VName)
-> m SrcLoc -> m (TypeExp Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc

instance ASTMappable (TypeArgExp Info VName) where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeArgExp Info VName -> m (TypeArgExp Info VName)
astMap ASTMapper m
tv (TypeArgExpSize SizeExp Info VName
dim) = SizeExp Info VName -> TypeArgExp Info VName
forall (f :: * -> *) vn. SizeExp f vn -> TypeArgExp f vn
TypeArgExpSize (SizeExp Info VName -> TypeArgExp Info VName)
-> m (SizeExp Info VName) -> m (TypeArgExp Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> SizeExp Info VName -> m (SizeExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> SizeExp Info VName -> m (SizeExp Info VName)
astMap ASTMapper m
tv SizeExp Info VName
dim
  astMap ASTMapper m
tv (TypeArgExpType TypeExp Info VName
te) = TypeExp Info VName -> TypeArgExp Info VName
forall (f :: * -> *) vn. TypeExp f vn -> TypeArgExp f vn
TypeArgExpType (TypeExp Info VName -> TypeArgExp Info VName)
-> m (TypeExp Info VName) -> m (TypeArgExp Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m -> TypeExp Info VName -> m (TypeExp Info VName)
astMap ASTMapper m
tv TypeExp Info VName
te

instance ASTMappable (SizeExp Info VName) where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m -> SizeExp Info VName -> m (SizeExp Info VName)
astMap ASTMapper m
tv (SizeExp ExpBase Info VName
e SrcLoc
loc) = ExpBase Info VName -> SrcLoc -> SizeExp Info VName
forall (f :: * -> *) vn. ExpBase f vn -> SrcLoc -> SizeExp f vn
SizeExp (ExpBase Info VName -> SrcLoc -> SizeExp Info VName)
-> m (ExpBase Info VName) -> m (SrcLoc -> SizeExp Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e m (SrcLoc -> SizeExp Info VName)
-> m SrcLoc -> m (SizeExp Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
_ (SizeExpAny SrcLoc
loc) = SizeExp Info VName -> m (SizeExp Info VName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SizeExp Info VName -> m (SizeExp Info VName))
-> SizeExp Info VName -> m (SizeExp Info VName)
forall a b. (a -> b) -> a -> b
$ SrcLoc -> SizeExp Info VName
forall (f :: * -> *) vn. SrcLoc -> SizeExp f vn
SizeExpAny SrcLoc
loc

instance ASTMappable (DimIndexBase Info VName) where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m
-> DimIndexBase Info VName -> m (DimIndexBase Info VName)
astMap ASTMapper m
tv (DimFix ExpBase Info VName
j) = ExpBase Info VName -> DimIndexBase Info VName
forall (f :: * -> *) vn. ExpBase f vn -> DimIndexBase f vn
DimFix (ExpBase Info VName -> DimIndexBase Info VName)
-> m (ExpBase Info VName) -> m (DimIndexBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
j
  astMap ASTMapper m
tv (DimSlice Maybe (ExpBase Info VName)
i Maybe (ExpBase Info VName)
j Maybe (ExpBase Info VName)
stride) =
    Maybe (ExpBase Info VName)
-> Maybe (ExpBase Info VName)
-> Maybe (ExpBase Info VName)
-> DimIndexBase Info VName
forall (f :: * -> *) vn.
Maybe (ExpBase f vn)
-> Maybe (ExpBase f vn)
-> Maybe (ExpBase f vn)
-> DimIndexBase f vn
DimSlice
      (Maybe (ExpBase Info VName)
 -> Maybe (ExpBase Info VName)
 -> Maybe (ExpBase Info VName)
 -> DimIndexBase Info VName)
-> m (Maybe (ExpBase Info VName))
-> m (Maybe (ExpBase Info VName)
      -> Maybe (ExpBase Info VName) -> DimIndexBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe (ExpBase Info VName))
-> (ExpBase Info VName -> m (Maybe (ExpBase Info VName)))
-> Maybe (ExpBase Info VName)
-> m (Maybe (ExpBase Info VName))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (ExpBase Info VName) -> m (Maybe (ExpBase Info VName))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ExpBase Info VName)
forall a. Maybe a
Nothing) ((ExpBase Info VName -> Maybe (ExpBase Info VName))
-> m (ExpBase Info VName) -> m (Maybe (ExpBase Info VName))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExpBase Info VName -> Maybe (ExpBase Info VName)
forall a. a -> Maybe a
Just (m (ExpBase Info VName) -> m (Maybe (ExpBase Info VName)))
-> (ExpBase Info VName -> m (ExpBase Info VName))
-> ExpBase Info VName
-> m (Maybe (ExpBase Info VName))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) Maybe (ExpBase Info VName)
i
      m (Maybe (ExpBase Info VName)
   -> Maybe (ExpBase Info VName) -> DimIndexBase Info VName)
-> m (Maybe (ExpBase Info VName))
-> m (Maybe (ExpBase Info VName) -> DimIndexBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Maybe (ExpBase Info VName))
-> (ExpBase Info VName -> m (Maybe (ExpBase Info VName)))
-> Maybe (ExpBase Info VName)
-> m (Maybe (ExpBase Info VName))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (ExpBase Info VName) -> m (Maybe (ExpBase Info VName))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ExpBase Info VName)
forall a. Maybe a
Nothing) ((ExpBase Info VName -> Maybe (ExpBase Info VName))
-> m (ExpBase Info VName) -> m (Maybe (ExpBase Info VName))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExpBase Info VName -> Maybe (ExpBase Info VName)
forall a. a -> Maybe a
Just (m (ExpBase Info VName) -> m (Maybe (ExpBase Info VName)))
-> (ExpBase Info VName -> m (ExpBase Info VName))
-> ExpBase Info VName
-> m (Maybe (ExpBase Info VName))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) Maybe (ExpBase Info VName)
j
      m (Maybe (ExpBase Info VName) -> DimIndexBase Info VName)
-> m (Maybe (ExpBase Info VName)) -> m (DimIndexBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Maybe (ExpBase Info VName))
-> (ExpBase Info VName -> m (Maybe (ExpBase Info VName)))
-> Maybe (ExpBase Info VName)
-> m (Maybe (ExpBase Info VName))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (ExpBase Info VName) -> m (Maybe (ExpBase Info VName))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ExpBase Info VName)
forall a. Maybe a
Nothing) ((ExpBase Info VName -> Maybe (ExpBase Info VName))
-> m (ExpBase Info VName) -> m (Maybe (ExpBase Info VName))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExpBase Info VName -> Maybe (ExpBase Info VName)
forall a. a -> Maybe a
Just (m (ExpBase Info VName) -> m (Maybe (ExpBase Info VName)))
-> (ExpBase Info VName -> m (ExpBase Info VName))
-> ExpBase Info VName
-> m (Maybe (ExpBase Info VName))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) Maybe (ExpBase Info VName)
stride

instance ASTMappable AppRes where
  astMap :: forall (m :: * -> *). Monad m => ASTMapper m -> AppRes -> m AppRes
astMap ASTMapper m
tv (AppRes StructType
t [VName]
ext) =
    StructType -> [VName] -> AppRes
AppRes (StructType -> [VName] -> AppRes)
-> m StructType -> m ([VName] -> AppRes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv StructType
t m ([VName] -> AppRes) -> m [VName] -> m AppRes
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [VName] -> m [VName]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [VName]
ext

type TypeTraverser f t dim1 als1 dim2 als2 =
  (QualName VName -> f (QualName VName)) ->
  (dim1 -> f dim2) ->
  (als1 -> f als2) ->
  t dim1 als1 ->
  f (t dim2 als2)

traverseScalarType ::
  (Applicative f) =>
  TypeTraverser f ScalarTypeBase dim1 als1 dims als2
traverseScalarType :: forall (f :: * -> *) dim1 als1 dims als2.
Applicative f =>
TypeTraverser f ScalarTypeBase dim1 als1 dims als2
traverseScalarType QualName VName -> f (QualName VName)
_ dim1 -> f dims
_ als1 -> f als2
_ (Prim PrimType
t) = ScalarTypeBase dims als2 -> f (ScalarTypeBase dims als2)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScalarTypeBase dims als2 -> f (ScalarTypeBase dims als2))
-> ScalarTypeBase dims als2 -> f (ScalarTypeBase dims als2)
forall a b. (a -> b) -> a -> b
$ PrimType -> ScalarTypeBase dims als2
forall dim u. PrimType -> ScalarTypeBase dim u
Prim PrimType
t
traverseScalarType QualName VName -> f (QualName VName)
f dim1 -> f dims
g als1 -> f als2
h (Record Map Name (TypeBase dim1 als1)
fs) = Map Name (TypeBase dims als2) -> ScalarTypeBase dims als2
forall dim u. Map Name (TypeBase dim u) -> ScalarTypeBase dim u
Record (Map Name (TypeBase dims als2) -> ScalarTypeBase dims als2)
-> f (Map Name (TypeBase dims als2))
-> f (ScalarTypeBase dims als2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeBase dim1 als1 -> f (TypeBase dims als2))
-> Map Name (TypeBase dim1 als1)
-> f (Map Name (TypeBase dims als2))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Name a -> f (Map Name b)
traverse (TypeTraverser f TypeBase dim1 als1 dims als2
forall (f :: * -> *) dim1 als1 dims als2.
Applicative f =>
TypeTraverser f TypeBase dim1 als1 dims als2
traverseType QualName VName -> f (QualName VName)
f dim1 -> f dims
g als1 -> f als2
h) Map Name (TypeBase dim1 als1)
fs
traverseScalarType QualName VName -> f (QualName VName)
f dim1 -> f dims
g als1 -> f als2
h (TypeVar als1
als QualName VName
t [TypeArg dim1]
args) =
  als2
-> QualName VName -> [TypeArg dims] -> ScalarTypeBase dims als2
forall dim u.
u -> QualName VName -> [TypeArg dim] -> ScalarTypeBase dim u
TypeVar (als2
 -> QualName VName -> [TypeArg dims] -> ScalarTypeBase dims als2)
-> f als2
-> f (QualName VName -> [TypeArg dims] -> ScalarTypeBase dims als2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> als1 -> f als2
h als1
als f (QualName VName -> [TypeArg dims] -> ScalarTypeBase dims als2)
-> f (QualName VName)
-> f ([TypeArg dims] -> ScalarTypeBase dims als2)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QualName VName -> f (QualName VName)
f QualName VName
t f ([TypeArg dims] -> ScalarTypeBase dims als2)
-> f [TypeArg dims] -> f (ScalarTypeBase dims als2)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TypeArg dim1 -> f (TypeArg dims))
-> [TypeArg dim1] -> f [TypeArg dims]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((QualName VName -> f (QualName VName))
-> (dim1 -> f dims) -> TypeArg dim1 -> f (TypeArg dims)
forall (f :: * -> *) dim1 dim2.
Applicative f =>
(QualName VName -> f (QualName VName))
-> (dim1 -> f dim2) -> TypeArg dim1 -> f (TypeArg dim2)
traverseTypeArg QualName VName -> f (QualName VName)
f dim1 -> f dims
g) [TypeArg dim1]
args
traverseScalarType QualName VName -> f (QualName VName)
f dim1 -> f dims
g als1 -> f als2
h (Arrow als1
als PName
v Diet
u TypeBase dim1 NoUniqueness
t1 (RetType [VName]
dims TypeBase dim1 Uniqueness
t2)) =
  als2
-> PName
-> Diet
-> TypeBase dims NoUniqueness
-> RetTypeBase dims Uniqueness
-> ScalarTypeBase dims als2
forall dim u.
u
-> PName
-> Diet
-> TypeBase dim NoUniqueness
-> RetTypeBase dim Uniqueness
-> ScalarTypeBase dim u
Arrow
    (als2
 -> PName
 -> Diet
 -> TypeBase dims NoUniqueness
 -> RetTypeBase dims Uniqueness
 -> ScalarTypeBase dims als2)
-> f als2
-> f (PName
      -> Diet
      -> TypeBase dims NoUniqueness
      -> RetTypeBase dims Uniqueness
      -> ScalarTypeBase dims als2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> als1 -> f als2
h als1
als
    f (PName
   -> Diet
   -> TypeBase dims NoUniqueness
   -> RetTypeBase dims Uniqueness
   -> ScalarTypeBase dims als2)
-> f PName
-> f (Diet
      -> TypeBase dims NoUniqueness
      -> RetTypeBase dims Uniqueness
      -> ScalarTypeBase dims als2)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PName -> f PName
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PName
v
    f (Diet
   -> TypeBase dims NoUniqueness
   -> RetTypeBase dims Uniqueness
   -> ScalarTypeBase dims als2)
-> f Diet
-> f (TypeBase dims NoUniqueness
      -> RetTypeBase dims Uniqueness -> ScalarTypeBase dims als2)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Diet -> f Diet
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Diet
u
    f (TypeBase dims NoUniqueness
   -> RetTypeBase dims Uniqueness -> ScalarTypeBase dims als2)
-> f (TypeBase dims NoUniqueness)
-> f (RetTypeBase dims Uniqueness -> ScalarTypeBase dims als2)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeTraverser f TypeBase dim1 NoUniqueness dims NoUniqueness
forall (f :: * -> *) dim1 als1 dims als2.
Applicative f =>
TypeTraverser f TypeBase dim1 als1 dims als2
traverseType QualName VName -> f (QualName VName)
f dim1 -> f dims
g NoUniqueness -> f NoUniqueness
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeBase dim1 NoUniqueness
t1
    f (RetTypeBase dims Uniqueness -> ScalarTypeBase dims als2)
-> f (RetTypeBase dims Uniqueness) -> f (ScalarTypeBase dims als2)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([VName] -> TypeBase dims Uniqueness -> RetTypeBase dims Uniqueness
forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [VName]
dims (TypeBase dims Uniqueness -> RetTypeBase dims Uniqueness)
-> f (TypeBase dims Uniqueness) -> f (RetTypeBase dims Uniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeTraverser f TypeBase dim1 Uniqueness dims Uniqueness
forall (f :: * -> *) dim1 als1 dims als2.
Applicative f =>
TypeTraverser f TypeBase dim1 als1 dims als2
traverseType QualName VName -> f (QualName VName)
f dim1 -> f dims
g Uniqueness -> f Uniqueness
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeBase dim1 Uniqueness
t2)
traverseScalarType QualName VName -> f (QualName VName)
f dim1 -> f dims
g als1 -> f als2
h (Sum Map Name [TypeBase dim1 als1]
cs) =
  Map Name [TypeBase dims als2] -> ScalarTypeBase dims als2
forall dim u. Map Name [TypeBase dim u] -> ScalarTypeBase dim u
Sum (Map Name [TypeBase dims als2] -> ScalarTypeBase dims als2)
-> f (Map Name [TypeBase dims als2])
-> f (ScalarTypeBase dims als2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([TypeBase dim1 als1] -> f [TypeBase dims als2])
-> Map Name [TypeBase dim1 als1]
-> f (Map Name [TypeBase dims als2])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Name a -> f (Map Name b)
traverse (([TypeBase dim1 als1] -> f [TypeBase dims als2])
 -> Map Name [TypeBase dim1 als1]
 -> f (Map Name [TypeBase dims als2]))
-> ((TypeBase dim1 als1 -> f (TypeBase dims als2))
    -> [TypeBase dim1 als1] -> f [TypeBase dims als2])
-> (TypeBase dim1 als1 -> f (TypeBase dims als2))
-> Map Name [TypeBase dim1 als1]
-> f (Map Name [TypeBase dims als2])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeBase dim1 als1 -> f (TypeBase dims als2))
-> [TypeBase dim1 als1] -> f [TypeBase dims als2]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse) (TypeTraverser f TypeBase dim1 als1 dims als2
forall (f :: * -> *) dim1 als1 dims als2.
Applicative f =>
TypeTraverser f TypeBase dim1 als1 dims als2
traverseType QualName VName -> f (QualName VName)
f dim1 -> f dims
g als1 -> f als2
h) Map Name [TypeBase dim1 als1]
cs

traverseType :: (Applicative f) => TypeTraverser f TypeBase dim1 als1 dims als2
traverseType :: forall (f :: * -> *) dim1 als1 dims als2.
Applicative f =>
TypeTraverser f TypeBase dim1 als1 dims als2
traverseType QualName VName -> f (QualName VName)
f dim1 -> f dims
g als1 -> f als2
h (Array als1
als Shape dim1
shape ScalarTypeBase dim1 NoUniqueness
et) =
  als2
-> Shape dims
-> ScalarTypeBase dims NoUniqueness
-> TypeBase dims als2
forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array (als2
 -> Shape dims
 -> ScalarTypeBase dims NoUniqueness
 -> TypeBase dims als2)
-> f als2
-> f (Shape dims
      -> ScalarTypeBase dims NoUniqueness -> TypeBase dims als2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> als1 -> f als2
h als1
als f (Shape dims
   -> ScalarTypeBase dims NoUniqueness -> TypeBase dims als2)
-> f (Shape dims)
-> f (ScalarTypeBase dims NoUniqueness -> TypeBase dims als2)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (dim1 -> f dims) -> Shape dim1 -> f (Shape dims)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Shape a -> f (Shape b)
traverse dim1 -> f dims
g Shape dim1
shape f (ScalarTypeBase dims NoUniqueness -> TypeBase dims als2)
-> f (ScalarTypeBase dims NoUniqueness) -> f (TypeBase dims als2)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeTraverser f ScalarTypeBase dim1 NoUniqueness dims NoUniqueness
forall (f :: * -> *) dim1 als1 dims als2.
Applicative f =>
TypeTraverser f ScalarTypeBase dim1 als1 dims als2
traverseScalarType QualName VName -> f (QualName VName)
f dim1 -> f dims
g NoUniqueness -> f NoUniqueness
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarTypeBase dim1 NoUniqueness
et
traverseType QualName VName -> f (QualName VName)
f dim1 -> f dims
g als1 -> f als2
h (Scalar ScalarTypeBase dim1 als1
t) =
  ScalarTypeBase dims als2 -> TypeBase dims als2
forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (ScalarTypeBase dims als2 -> TypeBase dims als2)
-> f (ScalarTypeBase dims als2) -> f (TypeBase dims als2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeTraverser f ScalarTypeBase dim1 als1 dims als2
forall (f :: * -> *) dim1 als1 dims als2.
Applicative f =>
TypeTraverser f ScalarTypeBase dim1 als1 dims als2
traverseScalarType QualName VName -> f (QualName VName)
f dim1 -> f dims
g als1 -> f als2
h ScalarTypeBase dim1 als1
t

traverseTypeArg ::
  (Applicative f) =>
  (QualName VName -> f (QualName VName)) ->
  (dim1 -> f dim2) ->
  TypeArg dim1 ->
  f (TypeArg dim2)
traverseTypeArg :: forall (f :: * -> *) dim1 dim2.
Applicative f =>
(QualName VName -> f (QualName VName))
-> (dim1 -> f dim2) -> TypeArg dim1 -> f (TypeArg dim2)
traverseTypeArg QualName VName -> f (QualName VName)
_ dim1 -> f dim2
g (TypeArgDim dim1
d) =
  dim2 -> TypeArg dim2
forall dim. dim -> TypeArg dim
TypeArgDim (dim2 -> TypeArg dim2) -> f dim2 -> f (TypeArg dim2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> dim1 -> f dim2
g dim1
d
traverseTypeArg QualName VName -> f (QualName VName)
f dim1 -> f dim2
g (TypeArgType TypeBase dim1 NoUniqueness
t) =
  TypeBase dim2 NoUniqueness -> TypeArg dim2
forall dim. TypeBase dim NoUniqueness -> TypeArg dim
TypeArgType (TypeBase dim2 NoUniqueness -> TypeArg dim2)
-> f (TypeBase dim2 NoUniqueness) -> f (TypeArg dim2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeTraverser f TypeBase dim1 NoUniqueness dim2 NoUniqueness
forall (f :: * -> *) dim1 als1 dims als2.
Applicative f =>
TypeTraverser f TypeBase dim1 als1 dims als2
traverseType QualName VName -> f (QualName VName)
f dim1 -> f dim2
g NoUniqueness -> f NoUniqueness
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeBase dim1 NoUniqueness
t

instance ASTMappable StructType where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m -> StructType -> m StructType
astMap ASTMapper m
tv = TypeTraverser
  m
  TypeBase
  (ExpBase Info VName)
  NoUniqueness
  (ExpBase Info VName)
  NoUniqueness
forall (f :: * -> *) dim1 als1 dims als2.
Applicative f =>
TypeTraverser f TypeBase dim1 als1 dims als2
traverseType (ASTMapper m -> QualName VName -> m (QualName VName)
forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv) (ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) NoUniqueness -> m NoUniqueness
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance ASTMappable ParamType where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m -> ParamType -> m ParamType
astMap ASTMapper m
tv = TypeTraverser
  m TypeBase (ExpBase Info VName) Diet (ExpBase Info VName) Diet
forall (f :: * -> *) dim1 als1 dims als2.
Applicative f =>
TypeTraverser f TypeBase dim1 als1 dims als2
traverseType (ASTMapper m -> QualName VName -> m (QualName VName)
forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv) (ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) Diet -> m Diet
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance ASTMappable (TypeBase Size Uniqueness) where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m
-> TypeBase (ExpBase Info VName) Uniqueness
-> m (TypeBase (ExpBase Info VName) Uniqueness)
astMap ASTMapper m
tv = TypeTraverser
  m
  TypeBase
  (ExpBase Info VName)
  Uniqueness
  (ExpBase Info VName)
  Uniqueness
forall (f :: * -> *) dim1 als1 dims als2.
Applicative f =>
TypeTraverser f TypeBase dim1 als1 dims als2
traverseType (ASTMapper m -> QualName VName -> m (QualName VName)
forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv) (ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) Uniqueness -> m Uniqueness
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance ASTMappable ResRetType where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m -> ResRetType -> m ResRetType
astMap ASTMapper m
tv (RetType [VName]
ext TypeBase (ExpBase Info VName) Uniqueness
t) = [VName] -> TypeBase (ExpBase Info VName) Uniqueness -> ResRetType
forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [VName]
ext (TypeBase (ExpBase Info VName) Uniqueness -> ResRetType)
-> m (TypeBase (ExpBase Info VName) Uniqueness) -> m ResRetType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m
-> TypeBase (ExpBase Info VName) Uniqueness
-> m (TypeBase (ExpBase Info VName) Uniqueness)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m
-> TypeBase (ExpBase Info VName) Uniqueness
-> m (TypeBase (ExpBase Info VName) Uniqueness)
astMap ASTMapper m
tv TypeBase (ExpBase Info VName) Uniqueness
t

instance ASTMappable (IdentBase Info VName StructType) where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m
-> IdentBase Info VName StructType
-> m (IdentBase Info VName StructType)
astMap ASTMapper m
tv (Ident VName
name (Info StructType
t) SrcLoc
loc) =
    VName
-> Info StructType -> SrcLoc -> IdentBase Info VName StructType
forall {k} (f :: k -> *) vn (t :: k).
vn -> f t -> SrcLoc -> IdentBase f vn t
Ident VName
name (Info StructType -> SrcLoc -> IdentBase Info VName StructType)
-> m (Info StructType)
-> m (SrcLoc -> IdentBase Info VName StructType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StructType -> Info StructType
forall a. a -> Info a
Info (StructType -> Info StructType)
-> m StructType -> m (Info StructType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv StructType
t) m (SrcLoc -> IdentBase Info VName StructType)
-> m SrcLoc -> m (IdentBase Info VName StructType)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc

traversePat :: (Monad m) => (t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
traversePat :: forall (m :: * -> *) t1 t2.
Monad m =>
(t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
traversePat t1 -> m t2
f (Id VName
name (Info t1
t) SrcLoc
loc) =
  VName -> Info t2 -> SrcLoc -> PatBase Info VName t2
forall (f :: * -> *) vn t. vn -> f t -> SrcLoc -> PatBase f vn t
Id VName
name (Info t2 -> SrcLoc -> PatBase Info VName t2)
-> m (Info t2) -> m (SrcLoc -> PatBase Info VName t2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t2 -> Info t2
forall a. a -> Info a
Info (t2 -> Info t2) -> m t2 -> m (Info t2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t1 -> m t2
f t1
t) m (SrcLoc -> PatBase Info VName t2)
-> m SrcLoc -> m (PatBase Info VName t2)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
traversePat t1 -> m t2
f (TuplePat [PatBase Info VName t1]
pats SrcLoc
loc) =
  [PatBase Info VName t2] -> SrcLoc -> PatBase Info VName t2
forall (f :: * -> *) vn t.
[PatBase f vn t] -> SrcLoc -> PatBase f vn t
TuplePat ([PatBase Info VName t2] -> SrcLoc -> PatBase Info VName t2)
-> m [PatBase Info VName t2] -> m (SrcLoc -> PatBase Info VName t2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PatBase Info VName t1 -> m (PatBase Info VName t2))
-> [PatBase Info VName t1] -> m [PatBase Info VName t2]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
forall (m :: * -> *) t1 t2.
Monad m =>
(t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
traversePat t1 -> m t2
f) [PatBase Info VName t1]
pats m (SrcLoc -> PatBase Info VName t2)
-> m SrcLoc -> m (PatBase Info VName t2)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
traversePat t1 -> m t2
f (RecordPat [(Name, PatBase Info VName t1)]
fields SrcLoc
loc) =
  [(Name, PatBase Info VName t2)] -> SrcLoc -> PatBase Info VName t2
forall (f :: * -> *) vn t.
[(Name, PatBase f vn t)] -> SrcLoc -> PatBase f vn t
RecordPat ([(Name, PatBase Info VName t2)]
 -> SrcLoc -> PatBase Info VName t2)
-> m [(Name, PatBase Info VName t2)]
-> m (SrcLoc -> PatBase Info VName t2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, PatBase Info VName t1) -> m (Name, PatBase Info VName t2))
-> [(Name, PatBase Info VName t1)]
-> m [(Name, PatBase Info VName t2)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((PatBase Info VName t1 -> m (PatBase Info VName t2))
-> (Name, PatBase Info VName t1) -> m (Name, PatBase Info VName t2)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (Name, a) -> f (Name, b)
traverse ((PatBase Info VName t1 -> m (PatBase Info VName t2))
 -> (Name, PatBase Info VName t1)
 -> m (Name, PatBase Info VName t2))
-> (PatBase Info VName t1 -> m (PatBase Info VName t2))
-> (Name, PatBase Info VName t1)
-> m (Name, PatBase Info VName t2)
forall a b. (a -> b) -> a -> b
$ (t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
forall (m :: * -> *) t1 t2.
Monad m =>
(t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
traversePat t1 -> m t2
f) [(Name, PatBase Info VName t1)]
fields m (SrcLoc -> PatBase Info VName t2)
-> m SrcLoc -> m (PatBase Info VName t2)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
traversePat t1 -> m t2
f (PatParens PatBase Info VName t1
pat SrcLoc
loc) =
  PatBase Info VName t2 -> SrcLoc -> PatBase Info VName t2
forall (f :: * -> *) vn t.
PatBase f vn t -> SrcLoc -> PatBase f vn t
PatParens (PatBase Info VName t2 -> SrcLoc -> PatBase Info VName t2)
-> m (PatBase Info VName t2) -> m (SrcLoc -> PatBase Info VName t2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
forall (m :: * -> *) t1 t2.
Monad m =>
(t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
traversePat t1 -> m t2
f PatBase Info VName t1
pat m (SrcLoc -> PatBase Info VName t2)
-> m SrcLoc -> m (PatBase Info VName t2)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
traversePat t1 -> m t2
f (PatAscription PatBase Info VName t1
pat TypeExp Info VName
t SrcLoc
loc) =
  PatBase Info VName t2
-> TypeExp Info VName -> SrcLoc -> PatBase Info VName t2
forall (f :: * -> *) vn t.
PatBase f vn t -> TypeExp f vn -> SrcLoc -> PatBase f vn t
PatAscription (PatBase Info VName t2
 -> TypeExp Info VName -> SrcLoc -> PatBase Info VName t2)
-> m (PatBase Info VName t2)
-> m (TypeExp Info VName -> SrcLoc -> PatBase Info VName t2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
forall (m :: * -> *) t1 t2.
Monad m =>
(t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
traversePat t1 -> m t2
f PatBase Info VName t1
pat m (TypeExp Info VName -> SrcLoc -> PatBase Info VName t2)
-> m (TypeExp Info VName) -> m (SrcLoc -> PatBase Info VName t2)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeExp Info VName -> m (TypeExp Info VName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeExp Info VName
t m (SrcLoc -> PatBase Info VName t2)
-> m SrcLoc -> m (PatBase Info VName t2)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
traversePat t1 -> m t2
f (Wildcard (Info t1
t) SrcLoc
loc) =
  Info t2 -> SrcLoc -> PatBase Info VName t2
forall (f :: * -> *) vn t. f t -> SrcLoc -> PatBase f vn t
Wildcard (Info t2 -> SrcLoc -> PatBase Info VName t2)
-> m (Info t2) -> m (SrcLoc -> PatBase Info VName t2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t2 -> Info t2
forall a. a -> Info a
Info (t2 -> Info t2) -> m t2 -> m (Info t2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t1 -> m t2
f t1
t) m (SrcLoc -> PatBase Info VName t2)
-> m SrcLoc -> m (PatBase Info VName t2)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
traversePat t1 -> m t2
f (PatLit PatLit
v (Info t1
t) SrcLoc
loc) =
  PatLit -> Info t2 -> SrcLoc -> PatBase Info VName t2
forall (f :: * -> *) vn t.
PatLit -> f t -> SrcLoc -> PatBase f vn t
PatLit PatLit
v (Info t2 -> SrcLoc -> PatBase Info VName t2)
-> m (Info t2) -> m (SrcLoc -> PatBase Info VName t2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t2 -> Info t2
forall a. a -> Info a
Info (t2 -> Info t2) -> m t2 -> m (Info t2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t1 -> m t2
f t1
t) m (SrcLoc -> PatBase Info VName t2)
-> m SrcLoc -> m (PatBase Info VName t2)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
traversePat t1 -> m t2
f (PatConstr Name
n (Info t1
t) [PatBase Info VName t1]
ps SrcLoc
loc) =
  Name
-> Info t2
-> [PatBase Info VName t2]
-> SrcLoc
-> PatBase Info VName t2
forall (f :: * -> *) vn t.
Name -> f t -> [PatBase f vn t] -> SrcLoc -> PatBase f vn t
PatConstr Name
n (Info t2
 -> [PatBase Info VName t2] -> SrcLoc -> PatBase Info VName t2)
-> m (Info t2)
-> m ([PatBase Info VName t2] -> SrcLoc -> PatBase Info VName t2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t2 -> Info t2
forall a. a -> Info a
Info (t2 -> Info t2) -> m t2 -> m (Info t2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t1 -> m t2
f t1
t) m ([PatBase Info VName t2] -> SrcLoc -> PatBase Info VName t2)
-> m [PatBase Info VName t2] -> m (SrcLoc -> PatBase Info VName t2)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PatBase Info VName t1 -> m (PatBase Info VName t2))
-> [PatBase Info VName t1] -> m [PatBase Info VName t2]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
forall (m :: * -> *) t1 t2.
Monad m =>
(t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
traversePat t1 -> m t2
f) [PatBase Info VName t1]
ps m (SrcLoc -> PatBase Info VName t2)
-> m SrcLoc -> m (PatBase Info VName t2)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
traversePat t1 -> m t2
f (PatAttr AttrInfo VName
attr PatBase Info VName t1
p SrcLoc
loc) =
  AttrInfo VName
-> PatBase Info VName t2 -> SrcLoc -> PatBase Info VName t2
forall (f :: * -> *) vn t.
AttrInfo vn -> PatBase f vn t -> SrcLoc -> PatBase f vn t
PatAttr AttrInfo VName
attr (PatBase Info VName t2 -> SrcLoc -> PatBase Info VName t2)
-> m (PatBase Info VName t2) -> m (SrcLoc -> PatBase Info VName t2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
forall (m :: * -> *) t1 t2.
Monad m =>
(t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
traversePat t1 -> m t2
f PatBase Info VName t1
p m (SrcLoc -> PatBase Info VName t2)
-> m SrcLoc -> m (PatBase Info VName t2)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc

instance ASTMappable (PatBase Info VName StructType) where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m
-> PatBase Info VName StructType
-> m (PatBase Info VName StructType)
astMap ASTMapper m
tv = (StructType -> m StructType)
-> PatBase Info VName StructType
-> m (PatBase Info VName StructType)
forall (m :: * -> *) t1 t2.
Monad m =>
(t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
traversePat ((StructType -> m StructType)
 -> PatBase Info VName StructType
 -> m (PatBase Info VName StructType))
-> (StructType -> m StructType)
-> PatBase Info VName StructType
-> m (PatBase Info VName StructType)
forall a b. (a -> b) -> a -> b
$ ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv

instance ASTMappable (PatBase Info VName ParamType) where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m
-> PatBase Info VName ParamType -> m (PatBase Info VName ParamType)
astMap ASTMapper m
tv = (ParamType -> m ParamType)
-> PatBase Info VName ParamType -> m (PatBase Info VName ParamType)
forall (m :: * -> *) t1 t2.
Monad m =>
(t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
traversePat ((ParamType -> m ParamType)
 -> PatBase Info VName ParamType
 -> m (PatBase Info VName ParamType))
-> (ParamType -> m ParamType)
-> PatBase Info VName ParamType
-> m (PatBase Info VName ParamType)
forall a b. (a -> b) -> a -> b
$ ASTMapper m -> ParamType -> m ParamType
forall (m :: * -> *). ASTMapper m -> ParamType -> m ParamType
mapOnParamType ASTMapper m
tv

instance ASTMappable (FieldBase Info VName) where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m -> FieldBase Info VName -> m (FieldBase Info VName)
astMap ASTMapper m
tv (RecordFieldExplicit Name
name ExpBase Info VName
e SrcLoc
loc) =
    Name -> ExpBase Info VName -> SrcLoc -> FieldBase Info VName
forall (f :: * -> *) vn.
Name -> ExpBase f vn -> SrcLoc -> FieldBase f vn
RecordFieldExplicit Name
name (ExpBase Info VName -> SrcLoc -> FieldBase Info VName)
-> m (ExpBase Info VName) -> m (SrcLoc -> FieldBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e m (SrcLoc -> FieldBase Info VName)
-> m SrcLoc -> m (FieldBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (RecordFieldImplicit VName
name Info StructType
t SrcLoc
loc) =
    VName -> Info StructType -> SrcLoc -> FieldBase Info VName
forall (f :: * -> *) vn.
vn -> f StructType -> SrcLoc -> FieldBase f vn
RecordFieldImplicit
      (VName -> Info StructType -> SrcLoc -> FieldBase Info VName)
-> m VName -> m (Info StructType -> SrcLoc -> FieldBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QualName VName -> VName
forall vn. QualName vn -> vn
qualLeaf (QualName VName -> VName) -> m (QualName VName) -> m VName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> QualName VName -> m (QualName VName)
forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv ([VName] -> VName -> QualName VName
forall vn. [vn] -> vn -> QualName vn
QualName [] VName
name))
      m (Info StructType -> SrcLoc -> FieldBase Info VName)
-> m (Info StructType) -> m (SrcLoc -> FieldBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StructType -> m StructType)
-> Info StructType -> m (Info StructType)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse (ASTMapper m -> StructType -> m StructType
forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t
      m (SrcLoc -> FieldBase Info VName)
-> m SrcLoc -> m (FieldBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc

instance ASTMappable (CaseBase Info VName) where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m -> CaseBase Info VName -> m (CaseBase Info VName)
astMap ASTMapper m
tv (CasePat PatBase Info VName StructType
pat ExpBase Info VName
e SrcLoc
loc) =
    PatBase Info VName StructType
-> ExpBase Info VName -> SrcLoc -> CaseBase Info VName
forall (f :: * -> *) vn.
PatBase f vn StructType -> ExpBase f vn -> SrcLoc -> CaseBase f vn
CasePat (PatBase Info VName StructType
 -> ExpBase Info VName -> SrcLoc -> CaseBase Info VName)
-> m (PatBase Info VName StructType)
-> m (ExpBase Info VName -> SrcLoc -> CaseBase Info VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m
-> PatBase Info VName StructType
-> m (PatBase Info VName StructType)
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *).
Monad m =>
ASTMapper m
-> PatBase Info VName StructType
-> m (PatBase Info VName StructType)
astMap ASTMapper m
tv PatBase Info VName StructType
pat m (ExpBase Info VName -> SrcLoc -> CaseBase Info VName)
-> m (ExpBase Info VName) -> m (SrcLoc -> CaseBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e m (SrcLoc -> CaseBase Info VName)
-> m SrcLoc -> m (CaseBase Info VName)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcLoc -> m SrcLoc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc

instance (ASTMappable a) => ASTMappable (Info a) where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m -> Info a -> m (Info a)
astMap ASTMapper m
tv = (a -> m a) -> Info a -> m (Info a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Info a -> f (Info b)
traverse ((a -> m a) -> Info a -> m (Info a))
-> (a -> m a) -> Info a -> m (Info a)
forall a b. (a -> b) -> a -> b
$ ASTMapper m -> a -> m a
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *). Monad m => ASTMapper m -> a -> m a
astMap ASTMapper m
tv

instance (ASTMappable a) => ASTMappable [a] where
  astMap :: forall (m :: * -> *). Monad m => ASTMapper m -> [a] -> m [a]
astMap ASTMapper m
tv = (a -> m a) -> [a] -> m [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((a -> m a) -> [a] -> m [a]) -> (a -> m a) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ ASTMapper m -> a -> m a
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *). Monad m => ASTMapper m -> a -> m a
astMap ASTMapper m
tv

instance (ASTMappable a) => ASTMappable (NE.NonEmpty a) where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m -> NonEmpty a -> m (NonEmpty a)
astMap ASTMapper m
tv = (a -> m a) -> NonEmpty a -> m (NonEmpty a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse ((a -> m a) -> NonEmpty a -> m (NonEmpty a))
-> (a -> m a) -> NonEmpty a -> m (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ ASTMapper m -> a -> m a
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *). Monad m => ASTMapper m -> a -> m a
astMap ASTMapper m
tv

instance (ASTMappable a, ASTMappable b) => ASTMappable (a, b) where
  astMap :: forall (m :: * -> *). Monad m => ASTMapper m -> (a, b) -> m (a, b)
astMap ASTMapper m
tv (a
x, b
y) = (,) (a -> b -> (a, b)) -> m a -> m (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> a -> m a
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *). Monad m => ASTMapper m -> a -> m a
astMap ASTMapper m
tv a
x m (b -> (a, b)) -> m b -> m (a, b)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> b -> m b
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *). Monad m => ASTMapper m -> b -> m b
astMap ASTMapper m
tv b
y

instance (ASTMappable a, ASTMappable b, ASTMappable c) => ASTMappable (a, b, c) where
  astMap :: forall (m :: * -> *).
Monad m =>
ASTMapper m -> (a, b, c) -> m (a, b, c)
astMap ASTMapper m
tv (a
x, b
y, c
z) = (,,) (a -> b -> c -> (a, b, c)) -> m a -> m (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTMapper m -> a -> m a
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *). Monad m => ASTMapper m -> a -> m a
astMap ASTMapper m
tv a
x m (b -> c -> (a, b, c)) -> m b -> m (c -> (a, b, c))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> b -> m b
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *). Monad m => ASTMapper m -> b -> m b
astMap ASTMapper m
tv b
y m (c -> (a, b, c)) -> m c -> m (a, b, c)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ASTMapper m -> c -> m c
forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
forall (m :: * -> *). Monad m => ASTMapper m -> c -> m c
astMap ASTMapper m
tv c
z

-- It would be lovely if the following code would be written in terms
-- of ASTMappable, but unfortunately it involves changing the Info
-- functor.  For simplicity, the general traversals do not support
-- that.  Sometimes a little duplication is better than an overly
-- complex abstraction.  The types ensure that this will be correct
-- anyway, so it's just tedious, and not actually fragile.

bareField :: FieldBase Info VName -> FieldBase NoInfo VName
bareField :: FieldBase Info VName -> FieldBase NoInfo VName
bareField (RecordFieldExplicit Name
name ExpBase Info VName
e SrcLoc
loc) =
  Name -> ExpBase NoInfo VName -> SrcLoc -> FieldBase NoInfo VName
forall (f :: * -> *) vn.
Name -> ExpBase f vn -> SrcLoc -> FieldBase f vn
RecordFieldExplicit Name
name (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e) SrcLoc
loc
bareField (RecordFieldImplicit VName
name Info StructType
_ SrcLoc
loc) =
  VName -> NoInfo StructType -> SrcLoc -> FieldBase NoInfo VName
forall (f :: * -> *) vn.
vn -> f StructType -> SrcLoc -> FieldBase f vn
RecordFieldImplicit VName
name NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc

barePat :: PatBase Info VName t -> PatBase NoInfo VName t
barePat :: forall t. PatBase Info VName t -> PatBase NoInfo VName t
barePat (TuplePat [PatBase Info VName t]
ps SrcLoc
loc) = [PatBase NoInfo VName t] -> SrcLoc -> PatBase NoInfo VName t
forall (f :: * -> *) vn t.
[PatBase f vn t] -> SrcLoc -> PatBase f vn t
TuplePat ((PatBase Info VName t -> PatBase NoInfo VName t)
-> [PatBase Info VName t] -> [PatBase NoInfo VName t]
forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName t -> PatBase NoInfo VName t
forall t. PatBase Info VName t -> PatBase NoInfo VName t
barePat [PatBase Info VName t]
ps) SrcLoc
loc
barePat (RecordPat [(Name, PatBase Info VName t)]
fs SrcLoc
loc) = [(Name, PatBase NoInfo VName t)]
-> SrcLoc -> PatBase NoInfo VName t
forall (f :: * -> *) vn t.
[(Name, PatBase f vn t)] -> SrcLoc -> PatBase f vn t
RecordPat (((Name, PatBase Info VName t) -> (Name, PatBase NoInfo VName t))
-> [(Name, PatBase Info VName t)]
-> [(Name, PatBase NoInfo VName t)]
forall a b. (a -> b) -> [a] -> [b]
map ((PatBase Info VName t -> PatBase NoInfo VName t)
-> (Name, PatBase Info VName t) -> (Name, PatBase NoInfo VName t)
forall a b. (a -> b) -> (Name, a) -> (Name, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PatBase Info VName t -> PatBase NoInfo VName t
forall t. PatBase Info VName t -> PatBase NoInfo VName t
barePat) [(Name, PatBase Info VName t)]
fs) SrcLoc
loc
barePat (PatParens PatBase Info VName t
p SrcLoc
loc) = PatBase NoInfo VName t -> SrcLoc -> PatBase NoInfo VName t
forall (f :: * -> *) vn t.
PatBase f vn t -> SrcLoc -> PatBase f vn t
PatParens (PatBase Info VName t -> PatBase NoInfo VName t
forall t. PatBase Info VName t -> PatBase NoInfo VName t
barePat PatBase Info VName t
p) SrcLoc
loc
barePat (Id VName
v Info t
_ SrcLoc
loc) = VName -> NoInfo t -> SrcLoc -> PatBase NoInfo VName t
forall (f :: * -> *) vn t. vn -> f t -> SrcLoc -> PatBase f vn t
Id VName
v NoInfo t
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
barePat (Wildcard Info t
_ SrcLoc
loc) = NoInfo t -> SrcLoc -> PatBase NoInfo VName t
forall (f :: * -> *) vn t. f t -> SrcLoc -> PatBase f vn t
Wildcard NoInfo t
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
barePat (PatAscription PatBase Info VName t
pat TypeExp Info VName
t SrcLoc
loc) = PatBase NoInfo VName t
-> TypeExp NoInfo VName -> SrcLoc -> PatBase NoInfo VName t
forall (f :: * -> *) vn t.
PatBase f vn t -> TypeExp f vn -> SrcLoc -> PatBase f vn t
PatAscription (PatBase Info VName t -> PatBase NoInfo VName t
forall t. PatBase Info VName t -> PatBase NoInfo VName t
barePat PatBase Info VName t
pat) (TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp TypeExp Info VName
t) SrcLoc
loc
barePat (PatLit PatLit
v Info t
_ SrcLoc
loc) = PatLit -> NoInfo t -> SrcLoc -> PatBase NoInfo VName t
forall (f :: * -> *) vn t.
PatLit -> f t -> SrcLoc -> PatBase f vn t
PatLit PatLit
v NoInfo t
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
barePat (PatConstr Name
c Info t
_ [PatBase Info VName t]
ps SrcLoc
loc) = Name
-> NoInfo t
-> [PatBase NoInfo VName t]
-> SrcLoc
-> PatBase NoInfo VName t
forall (f :: * -> *) vn t.
Name -> f t -> [PatBase f vn t] -> SrcLoc -> PatBase f vn t
PatConstr Name
c NoInfo t
forall {k} (a :: k). NoInfo a
NoInfo ((PatBase Info VName t -> PatBase NoInfo VName t)
-> [PatBase Info VName t] -> [PatBase NoInfo VName t]
forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName t -> PatBase NoInfo VName t
forall t. PatBase Info VName t -> PatBase NoInfo VName t
barePat [PatBase Info VName t]
ps) SrcLoc
loc
barePat (PatAttr AttrInfo VName
attr PatBase Info VName t
p SrcLoc
loc) = AttrInfo VName
-> PatBase NoInfo VName t -> SrcLoc -> PatBase NoInfo VName t
forall (f :: * -> *) vn t.
AttrInfo vn -> PatBase f vn t -> SrcLoc -> PatBase f vn t
PatAttr AttrInfo VName
attr (PatBase Info VName t -> PatBase NoInfo VName t
forall t. PatBase Info VName t -> PatBase NoInfo VName t
barePat PatBase Info VName t
p) SrcLoc
loc

bareDimIndex :: DimIndexBase Info VName -> DimIndexBase NoInfo VName
bareDimIndex :: DimIndexBase Info VName -> DimIndexBase NoInfo VName
bareDimIndex (DimFix ExpBase Info VName
e) =
  ExpBase NoInfo VName -> DimIndexBase NoInfo VName
forall (f :: * -> *) vn. ExpBase f vn -> DimIndexBase f vn
DimFix (ExpBase NoInfo VName -> DimIndexBase NoInfo VName)
-> ExpBase NoInfo VName -> DimIndexBase NoInfo VName
forall a b. (a -> b) -> a -> b
$ ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e
bareDimIndex (DimSlice Maybe (ExpBase Info VName)
x Maybe (ExpBase Info VName)
y Maybe (ExpBase Info VName)
z) =
  Maybe (ExpBase NoInfo VName)
-> Maybe (ExpBase NoInfo VName)
-> Maybe (ExpBase NoInfo VName)
-> DimIndexBase NoInfo VName
forall (f :: * -> *) vn.
Maybe (ExpBase f vn)
-> Maybe (ExpBase f vn)
-> Maybe (ExpBase f vn)
-> DimIndexBase f vn
DimSlice (ExpBase Info VName -> ExpBase NoInfo VName
bareExp (ExpBase Info VName -> ExpBase NoInfo VName)
-> Maybe (ExpBase Info VName) -> Maybe (ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ExpBase Info VName)
x) (ExpBase Info VName -> ExpBase NoInfo VName
bareExp (ExpBase Info VName -> ExpBase NoInfo VName)
-> Maybe (ExpBase Info VName) -> Maybe (ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ExpBase Info VName)
y) (ExpBase Info VName -> ExpBase NoInfo VName
bareExp (ExpBase Info VName -> ExpBase NoInfo VName)
-> Maybe (ExpBase Info VName) -> Maybe (ExpBase NoInfo VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ExpBase Info VName)
z)

bareLoopForm :: LoopFormBase Info VName -> LoopFormBase NoInfo VName
bareLoopForm :: LoopFormBase Info VName -> LoopFormBase NoInfo VName
bareLoopForm (For (Ident VName
i Info StructType
_ SrcLoc
loc) ExpBase Info VName
e) = IdentBase NoInfo VName StructType
-> ExpBase NoInfo VName -> LoopFormBase NoInfo VName
forall (f :: * -> *) vn.
IdentBase f vn StructType -> ExpBase f vn -> LoopFormBase f vn
For (VName
-> NoInfo StructType -> SrcLoc -> IdentBase NoInfo VName StructType
forall {k} (f :: k -> *) vn (t :: k).
vn -> f t -> SrcLoc -> IdentBase f vn t
Ident VName
i NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc) (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e)
bareLoopForm (ForIn PatBase Info VName StructType
pat ExpBase Info VName
e) = PatBase NoInfo VName StructType
-> ExpBase NoInfo VName -> LoopFormBase NoInfo VName
forall (f :: * -> *) vn.
PatBase f vn StructType -> ExpBase f vn -> LoopFormBase f vn
ForIn (PatBase Info VName StructType -> PatBase NoInfo VName StructType
forall t. PatBase Info VName t -> PatBase NoInfo VName t
barePat PatBase Info VName StructType
pat) (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e)
bareLoopForm (While ExpBase Info VName
e) = ExpBase NoInfo VName -> LoopFormBase NoInfo VName
forall (f :: * -> *) vn. ExpBase f vn -> LoopFormBase f vn
While (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e)

bareCase :: CaseBase Info VName -> CaseBase NoInfo VName
bareCase :: CaseBase Info VName -> CaseBase NoInfo VName
bareCase (CasePat PatBase Info VName StructType
pat ExpBase Info VName
e SrcLoc
loc) = PatBase NoInfo VName StructType
-> ExpBase NoInfo VName -> SrcLoc -> CaseBase NoInfo VName
forall (f :: * -> *) vn.
PatBase f vn StructType -> ExpBase f vn -> SrcLoc -> CaseBase f vn
CasePat (PatBase Info VName StructType -> PatBase NoInfo VName StructType
forall t. PatBase Info VName t -> PatBase NoInfo VName t
barePat PatBase Info VName StructType
pat) (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e) SrcLoc
loc

bareSizeExp :: SizeExp Info VName -> SizeExp NoInfo VName
bareSizeExp :: SizeExp Info VName -> SizeExp NoInfo VName
bareSizeExp (SizeExp ExpBase Info VName
e SrcLoc
loc) = ExpBase NoInfo VName -> SrcLoc -> SizeExp NoInfo VName
forall (f :: * -> *) vn. ExpBase f vn -> SrcLoc -> SizeExp f vn
SizeExp (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e) SrcLoc
loc
bareSizeExp (SizeExpAny SrcLoc
loc) = SrcLoc -> SizeExp NoInfo VName
forall (f :: * -> *) vn. SrcLoc -> SizeExp f vn
SizeExpAny SrcLoc
loc

bareTypeExp :: TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp :: TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp (TEVar QualName VName
qn SrcLoc
loc) = QualName VName -> SrcLoc -> TypeExp NoInfo VName
forall (f :: * -> *) vn. QualName vn -> SrcLoc -> TypeExp f vn
TEVar QualName VName
qn SrcLoc
loc
bareTypeExp (TEParens TypeExp Info VName
te SrcLoc
loc) = TypeExp NoInfo VName -> SrcLoc -> TypeExp NoInfo VName
forall (f :: * -> *) vn. TypeExp f vn -> SrcLoc -> TypeExp f vn
TEParens (TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp TypeExp Info VName
te) SrcLoc
loc
bareTypeExp (TETuple [TypeExp Info VName]
tys SrcLoc
loc) = [TypeExp NoInfo VName] -> SrcLoc -> TypeExp NoInfo VName
forall (f :: * -> *) vn. [TypeExp f vn] -> SrcLoc -> TypeExp f vn
TETuple ((TypeExp Info VName -> TypeExp NoInfo VName)
-> [TypeExp Info VName] -> [TypeExp NoInfo VName]
forall a b. (a -> b) -> [a] -> [b]
map TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp [TypeExp Info VName]
tys) SrcLoc
loc
bareTypeExp (TERecord [(Name, TypeExp Info VName)]
fs SrcLoc
loc) = [(Name, TypeExp NoInfo VName)] -> SrcLoc -> TypeExp NoInfo VName
forall (f :: * -> *) vn.
[(Name, TypeExp f vn)] -> SrcLoc -> TypeExp f vn
TERecord (((Name, TypeExp Info VName) -> (Name, TypeExp NoInfo VName))
-> [(Name, TypeExp Info VName)] -> [(Name, TypeExp NoInfo VName)]
forall a b. (a -> b) -> [a] -> [b]
map ((TypeExp Info VName -> TypeExp NoInfo VName)
-> (Name, TypeExp Info VName) -> (Name, TypeExp NoInfo VName)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp) [(Name, TypeExp Info VName)]
fs) SrcLoc
loc
bareTypeExp (TEArray SizeExp Info VName
size TypeExp Info VName
ty SrcLoc
loc) = SizeExp NoInfo VName
-> TypeExp NoInfo VName -> SrcLoc -> TypeExp NoInfo VName
forall (f :: * -> *) vn.
SizeExp f vn -> TypeExp f vn -> SrcLoc -> TypeExp f vn
TEArray (SizeExp Info VName -> SizeExp NoInfo VName
bareSizeExp SizeExp Info VName
size) (TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp TypeExp Info VName
ty) SrcLoc
loc
bareTypeExp (TEUnique TypeExp Info VName
ty SrcLoc
loc) = TypeExp NoInfo VName -> SrcLoc -> TypeExp NoInfo VName
forall (f :: * -> *) vn. TypeExp f vn -> SrcLoc -> TypeExp f vn
TEUnique (TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp TypeExp Info VName
ty) SrcLoc
loc
bareTypeExp (TEApply TypeExp Info VName
ty TypeArgExp Info VName
ta SrcLoc
loc) = TypeExp NoInfo VName
-> TypeArgExp NoInfo VName -> SrcLoc -> TypeExp NoInfo VName
forall (f :: * -> *) vn.
TypeExp f vn -> TypeArgExp f vn -> SrcLoc -> TypeExp f vn
TEApply (TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp TypeExp Info VName
ty) (TypeArgExp Info VName -> TypeArgExp NoInfo VName
bareTypeArgExp TypeArgExp Info VName
ta) SrcLoc
loc
  where
    bareTypeArgExp :: TypeArgExp Info VName -> TypeArgExp NoInfo VName
bareTypeArgExp (TypeArgExpSize SizeExp Info VName
size) =
      SizeExp NoInfo VName -> TypeArgExp NoInfo VName
forall (f :: * -> *) vn. SizeExp f vn -> TypeArgExp f vn
TypeArgExpSize (SizeExp NoInfo VName -> TypeArgExp NoInfo VName)
-> SizeExp NoInfo VName -> TypeArgExp NoInfo VName
forall a b. (a -> b) -> a -> b
$ SizeExp Info VName -> SizeExp NoInfo VName
bareSizeExp SizeExp Info VName
size
    bareTypeArgExp (TypeArgExpType TypeExp Info VName
tya) =
      TypeExp NoInfo VName -> TypeArgExp NoInfo VName
forall (f :: * -> *) vn. TypeExp f vn -> TypeArgExp f vn
TypeArgExpType (TypeExp NoInfo VName -> TypeArgExp NoInfo VName)
-> TypeExp NoInfo VName -> TypeArgExp NoInfo VName
forall a b. (a -> b) -> a -> b
$ TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp TypeExp Info VName
tya
bareTypeExp (TEArrow Maybe VName
arg TypeExp Info VName
tya TypeExp Info VName
tyr SrcLoc
loc) = Maybe VName
-> TypeExp NoInfo VName
-> TypeExp NoInfo VName
-> SrcLoc
-> TypeExp NoInfo VName
forall (f :: * -> *) vn.
Maybe vn -> TypeExp f vn -> TypeExp f vn -> SrcLoc -> TypeExp f vn
TEArrow Maybe VName
arg (TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp TypeExp Info VName
tya) (TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp TypeExp Info VName
tyr) SrcLoc
loc
bareTypeExp (TESum [(Name, [TypeExp Info VName])]
cs SrcLoc
loc) = [(Name, [TypeExp NoInfo VName])] -> SrcLoc -> TypeExp NoInfo VName
forall (f :: * -> *) vn.
[(Name, [TypeExp f vn])] -> SrcLoc -> TypeExp f vn
TESum (((Name, [TypeExp Info VName]) -> (Name, [TypeExp NoInfo VName]))
-> [(Name, [TypeExp Info VName])]
-> [(Name, [TypeExp NoInfo VName])]
forall a b. (a -> b) -> [a] -> [b]
map (([TypeExp Info VName] -> [TypeExp NoInfo VName])
-> (Name, [TypeExp Info VName]) -> (Name, [TypeExp NoInfo VName])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([TypeExp Info VName] -> [TypeExp NoInfo VName])
 -> (Name, [TypeExp Info VName]) -> (Name, [TypeExp NoInfo VName]))
-> ([TypeExp Info VName] -> [TypeExp NoInfo VName])
-> (Name, [TypeExp Info VName])
-> (Name, [TypeExp NoInfo VName])
forall a b. (a -> b) -> a -> b
$ (TypeExp Info VName -> TypeExp NoInfo VName)
-> [TypeExp Info VName] -> [TypeExp NoInfo VName]
forall a b. (a -> b) -> [a] -> [b]
map TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp) [(Name, [TypeExp Info VName])]
cs) SrcLoc
loc
bareTypeExp (TEDim [VName]
names TypeExp Info VName
ty SrcLoc
loc) = [VName] -> TypeExp NoInfo VName -> SrcLoc -> TypeExp NoInfo VName
forall (f :: * -> *) vn.
[vn] -> TypeExp f vn -> SrcLoc -> TypeExp f vn
TEDim [VName]
names (TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp TypeExp Info VName
ty) SrcLoc
loc

-- | Remove all annotations from an expression, but retain the
-- name/scope information.
bareExp :: ExpBase Info VName -> ExpBase NoInfo VName
bareExp :: ExpBase Info VName -> ExpBase NoInfo VName
bareExp (Var QualName VName
name Info StructType
_ SrcLoc
loc) = QualName VName
-> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
QualName vn -> f StructType -> SrcLoc -> ExpBase f vn
Var QualName VName
name NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Hole Info StructType
_ SrcLoc
loc) = NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn. f StructType -> SrcLoc -> ExpBase f vn
Hole NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Literal PrimValue
v SrcLoc
loc) = PrimValue -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn. PrimValue -> SrcLoc -> ExpBase f vn
Literal PrimValue
v SrcLoc
loc
bareExp (IntLit Integer
val Info StructType
_ SrcLoc
loc) = Integer -> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
Integer -> f StructType -> SrcLoc -> ExpBase f vn
IntLit Integer
val NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (FloatLit Double
val Info StructType
_ SrcLoc
loc) = Double -> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
Double -> f StructType -> SrcLoc -> ExpBase f vn
FloatLit Double
val NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Parens ExpBase Info VName
e SrcLoc
loc) = ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn. ExpBase f vn -> SrcLoc -> ExpBase f vn
Parens (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e) SrcLoc
loc
bareExp (QualParens (QualName VName, SrcLoc)
name ExpBase Info VName
e SrcLoc
loc) = (QualName VName, SrcLoc)
-> ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
(QualName vn, SrcLoc) -> ExpBase f vn -> SrcLoc -> ExpBase f vn
QualParens (QualName VName, SrcLoc)
name (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e) SrcLoc
loc
bareExp (TupLit [ExpBase Info VName]
els SrcLoc
loc) = [ExpBase NoInfo VName] -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn. [ExpBase f vn] -> SrcLoc -> ExpBase f vn
TupLit ((ExpBase Info VName -> ExpBase NoInfo VName)
-> [ExpBase Info VName] -> [ExpBase NoInfo VName]
forall a b. (a -> b) -> [a] -> [b]
map ExpBase Info VName -> ExpBase NoInfo VName
bareExp [ExpBase Info VName]
els) SrcLoc
loc
bareExp (StringLit [Word8]
vs SrcLoc
loc) = [Word8] -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn. [Word8] -> SrcLoc -> ExpBase f vn
StringLit [Word8]
vs SrcLoc
loc
bareExp (RecordLit [FieldBase Info VName]
fields SrcLoc
loc) = [FieldBase NoInfo VName] -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn. [FieldBase f vn] -> SrcLoc -> ExpBase f vn
RecordLit ((FieldBase Info VName -> FieldBase NoInfo VName)
-> [FieldBase Info VName] -> [FieldBase NoInfo VName]
forall a b. (a -> b) -> [a] -> [b]
map FieldBase Info VName -> FieldBase NoInfo VName
bareField [FieldBase Info VName]
fields) SrcLoc
loc
bareExp (ArrayLit [ExpBase Info VName]
els Info StructType
_ SrcLoc
loc) = [ExpBase NoInfo VName]
-> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
[ExpBase f vn] -> f StructType -> SrcLoc -> ExpBase f vn
ArrayLit ((ExpBase Info VName -> ExpBase NoInfo VName)
-> [ExpBase Info VName] -> [ExpBase NoInfo VName]
forall a b. (a -> b) -> [a] -> [b]
map ExpBase Info VName -> ExpBase NoInfo VName
bareExp [ExpBase Info VName]
els) NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Ascript ExpBase Info VName
e TypeExp Info VName
te SrcLoc
loc) = ExpBase NoInfo VName
-> TypeExp NoInfo VName -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn -> TypeExp f vn -> SrcLoc -> ExpBase f vn
Ascript (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e) (TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp TypeExp Info VName
te) SrcLoc
loc
bareExp (Coerce ExpBase Info VName
e TypeExp Info VName
te Info StructType
_ SrcLoc
loc) = ExpBase NoInfo VName
-> TypeExp NoInfo VName
-> NoInfo StructType
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn
-> TypeExp f vn -> f StructType -> SrcLoc -> ExpBase f vn
Coerce (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e) (TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp TypeExp Info VName
te) NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Negate ExpBase Info VName
x SrcLoc
loc) = ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn. ExpBase f vn -> SrcLoc -> ExpBase f vn
Negate (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
x) SrcLoc
loc
bareExp (Not ExpBase Info VName
x SrcLoc
loc) = ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn. ExpBase f vn -> SrcLoc -> ExpBase f vn
Not (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
x) SrcLoc
loc
bareExp (Update ExpBase Info VName
src SliceBase Info VName
slice ExpBase Info VName
v SrcLoc
loc) =
  ExpBase NoInfo VName
-> SliceBase NoInfo VName
-> ExpBase NoInfo VName
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn
-> SliceBase f vn -> ExpBase f vn -> SrcLoc -> ExpBase f vn
Update (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
src) ((DimIndexBase Info VName -> DimIndexBase NoInfo VName)
-> SliceBase Info VName -> SliceBase NoInfo VName
forall a b. (a -> b) -> [a] -> [b]
map DimIndexBase Info VName -> DimIndexBase NoInfo VName
bareDimIndex SliceBase Info VName
slice) (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
v) SrcLoc
loc
bareExp (RecordUpdate ExpBase Info VName
src [Name]
fs ExpBase Info VName
v Info StructType
_ SrcLoc
loc) =
  ExpBase NoInfo VName
-> [Name]
-> ExpBase NoInfo VName
-> NoInfo StructType
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn
-> [Name] -> ExpBase f vn -> f StructType -> SrcLoc -> ExpBase f vn
RecordUpdate (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
src) [Name]
fs (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
v) NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Project Name
field ExpBase Info VName
e Info StructType
_ SrcLoc
loc) =
  Name
-> ExpBase NoInfo VName
-> NoInfo StructType
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
Name -> ExpBase f vn -> f StructType -> SrcLoc -> ExpBase f vn
Project Name
field (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e) NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Assert ExpBase Info VName
e1 ExpBase Info VName
e2 Info Text
_ SrcLoc
loc) = ExpBase NoInfo VName
-> ExpBase NoInfo VName
-> NoInfo Text
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn -> ExpBase f vn -> f Text -> SrcLoc -> ExpBase f vn
Assert (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e1) (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e2) NoInfo Text
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Lambda [PatBase Info VName ParamType]
params ExpBase Info VName
body Maybe (TypeExp Info VName)
ret Info ResRetType
_ SrcLoc
loc) =
  [PatBase NoInfo VName ParamType]
-> ExpBase NoInfo VName
-> Maybe (TypeExp NoInfo VName)
-> NoInfo ResRetType
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
[PatBase f vn ParamType]
-> ExpBase f vn
-> Maybe (TypeExp f vn)
-> f ResRetType
-> SrcLoc
-> ExpBase f vn
Lambda ((PatBase Info VName ParamType -> PatBase NoInfo VName ParamType)
-> [PatBase Info VName ParamType]
-> [PatBase NoInfo VName ParamType]
forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName ParamType -> PatBase NoInfo VName ParamType
forall t. PatBase Info VName t -> PatBase NoInfo VName t
barePat [PatBase Info VName ParamType]
params) (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
body) ((TypeExp Info VName -> TypeExp NoInfo VName)
-> Maybe (TypeExp Info VName) -> Maybe (TypeExp NoInfo VName)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp Maybe (TypeExp Info VName)
ret) NoInfo ResRetType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (OpSection QualName VName
name Info StructType
_ SrcLoc
loc) = QualName VName
-> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
QualName vn -> f StructType -> SrcLoc -> ExpBase f vn
OpSection QualName VName
name NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (OpSectionLeft QualName VName
name Info StructType
_ ExpBase Info VName
arg (Info (PName, ParamType, Maybe VName), Info (PName, ParamType))
_ (Info ResRetType, Info [VName])
_ SrcLoc
loc) =
  QualName VName
-> NoInfo StructType
-> ExpBase NoInfo VName
-> (NoInfo (PName, ParamType, Maybe VName),
    NoInfo (PName, ParamType))
-> (NoInfo ResRetType, NoInfo [VName])
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
QualName vn
-> f StructType
-> ExpBase f vn
-> (f (PName, ParamType, Maybe VName), f (PName, ParamType))
-> (f ResRetType, f [VName])
-> SrcLoc
-> ExpBase f vn
OpSectionLeft QualName VName
name NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
arg) (NoInfo (PName, ParamType, Maybe VName)
forall {k} (a :: k). NoInfo a
NoInfo, NoInfo (PName, ParamType)
forall {k} (a :: k). NoInfo a
NoInfo) (NoInfo ResRetType
forall {k} (a :: k). NoInfo a
NoInfo, NoInfo [VName]
forall {k} (a :: k). NoInfo a
NoInfo) SrcLoc
loc
bareExp (OpSectionRight QualName VName
name Info StructType
_ ExpBase Info VName
arg (Info (PName, ParamType), Info (PName, ParamType, Maybe VName))
_ Info ResRetType
_ SrcLoc
loc) =
  QualName VName
-> NoInfo StructType
-> ExpBase NoInfo VName
-> (NoInfo (PName, ParamType),
    NoInfo (PName, ParamType, Maybe VName))
-> NoInfo ResRetType
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
QualName vn
-> f StructType
-> ExpBase f vn
-> (f (PName, ParamType), f (PName, ParamType, Maybe VName))
-> f ResRetType
-> SrcLoc
-> ExpBase f vn
OpSectionRight QualName VName
name NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
arg) (NoInfo (PName, ParamType)
forall {k} (a :: k). NoInfo a
NoInfo, NoInfo (PName, ParamType, Maybe VName)
forall {k} (a :: k). NoInfo a
NoInfo) NoInfo ResRetType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (ProjectSection [Name]
fields Info StructType
_ SrcLoc
loc) = [Name] -> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
[Name] -> f StructType -> SrcLoc -> ExpBase f vn
ProjectSection [Name]
fields NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (IndexSection SliceBase Info VName
slice Info StructType
_ SrcLoc
loc) =
  SliceBase NoInfo VName
-> NoInfo StructType -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
SliceBase f vn -> f StructType -> SrcLoc -> ExpBase f vn
IndexSection ((DimIndexBase Info VName -> DimIndexBase NoInfo VName)
-> SliceBase Info VName -> SliceBase NoInfo VName
forall a b. (a -> b) -> [a] -> [b]
map DimIndexBase Info VName -> DimIndexBase NoInfo VName
bareDimIndex SliceBase Info VName
slice) NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Constr Name
name [ExpBase Info VName]
es Info StructType
_ SrcLoc
loc) =
  Name
-> [ExpBase NoInfo VName]
-> NoInfo StructType
-> SrcLoc
-> ExpBase NoInfo VName
forall (f :: * -> *) vn.
Name -> [ExpBase f vn] -> f StructType -> SrcLoc -> ExpBase f vn
Constr Name
name ((ExpBase Info VName -> ExpBase NoInfo VName)
-> [ExpBase Info VName] -> [ExpBase NoInfo VName]
forall a b. (a -> b) -> [a] -> [b]
map ExpBase Info VName -> ExpBase NoInfo VName
bareExp [ExpBase Info VName]
es) NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (AppExp AppExpBase Info VName
appexp Info AppRes
_) =
  AppExpBase NoInfo VName -> NoInfo AppRes -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
AppExpBase f vn -> f AppRes -> ExpBase f vn
AppExp AppExpBase NoInfo VName
appexp' NoInfo AppRes
forall {k} (a :: k). NoInfo a
NoInfo
  where
    appexp' :: AppExpBase NoInfo VName
appexp' =
      case AppExpBase Info VName
appexp of
        Match ExpBase Info VName
e NonEmpty (CaseBase Info VName)
cases SrcLoc
loc ->
          ExpBase NoInfo VName
-> NonEmpty (CaseBase NoInfo VName)
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn
-> NonEmpty (CaseBase f vn) -> SrcLoc -> AppExpBase f vn
Match (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e) ((CaseBase Info VName -> CaseBase NoInfo VName)
-> NonEmpty (CaseBase Info VName)
-> NonEmpty (CaseBase NoInfo VName)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CaseBase Info VName -> CaseBase NoInfo VName
bareCase NonEmpty (CaseBase Info VName)
cases) SrcLoc
loc
        Loop [VName]
_ PatBase Info VName ParamType
mergepat ExpBase Info VName
mergeexp LoopFormBase Info VName
form ExpBase Info VName
loopbody SrcLoc
loc ->
          [VName]
-> PatBase NoInfo VName ParamType
-> ExpBase NoInfo VName
-> LoopFormBase NoInfo VName
-> ExpBase NoInfo VName
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
[VName]
-> PatBase f vn ParamType
-> ExpBase f vn
-> LoopFormBase f vn
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
Loop
            []
            (PatBase Info VName ParamType -> PatBase NoInfo VName ParamType
forall t. PatBase Info VName t -> PatBase NoInfo VName t
barePat PatBase Info VName ParamType
mergepat)
            (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
mergeexp)
            (LoopFormBase Info VName -> LoopFormBase NoInfo VName
bareLoopForm LoopFormBase Info VName
form)
            (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
loopbody)
            SrcLoc
loc
        LetWith (Ident VName
dest Info StructType
_ SrcLoc
destloc) (Ident VName
src Info StructType
_ SrcLoc
srcloc) SliceBase Info VName
idxexps ExpBase Info VName
vexp ExpBase Info VName
body SrcLoc
loc ->
          IdentBase NoInfo VName StructType
-> IdentBase NoInfo VName StructType
-> SliceBase NoInfo VName
-> ExpBase NoInfo VName
-> ExpBase NoInfo VName
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
IdentBase f vn StructType
-> IdentBase f vn StructType
-> SliceBase f vn
-> ExpBase f vn
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
LetWith
            (VName
-> NoInfo StructType -> SrcLoc -> IdentBase NoInfo VName StructType
forall {k} (f :: k -> *) vn (t :: k).
vn -> f t -> SrcLoc -> IdentBase f vn t
Ident VName
dest NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
destloc)
            (VName
-> NoInfo StructType -> SrcLoc -> IdentBase NoInfo VName StructType
forall {k} (f :: k -> *) vn (t :: k).
vn -> f t -> SrcLoc -> IdentBase f vn t
Ident VName
src NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
srcloc)
            ((DimIndexBase Info VName -> DimIndexBase NoInfo VName)
-> SliceBase Info VName -> SliceBase NoInfo VName
forall a b. (a -> b) -> [a] -> [b]
map DimIndexBase Info VName -> DimIndexBase NoInfo VName
bareDimIndex SliceBase Info VName
idxexps)
            (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
vexp)
            (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
body)
            SrcLoc
loc
        BinOp (QualName VName, SrcLoc)
fname Info StructType
_ (ExpBase Info VName
x, Info (Maybe VName)
_) (ExpBase Info VName
y, Info (Maybe VName)
_) SrcLoc
loc ->
          (QualName VName, SrcLoc)
-> NoInfo StructType
-> (ExpBase NoInfo VName, NoInfo (Maybe VName))
-> (ExpBase NoInfo VName, NoInfo (Maybe VName))
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
(QualName vn, SrcLoc)
-> f StructType
-> (ExpBase f vn, f (Maybe VName))
-> (ExpBase f vn, f (Maybe VName))
-> SrcLoc
-> AppExpBase f vn
BinOp (QualName VName, SrcLoc)
fname NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
x, NoInfo (Maybe VName)
forall {k} (a :: k). NoInfo a
NoInfo) (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
y, NoInfo (Maybe VName)
forall {k} (a :: k). NoInfo a
NoInfo) SrcLoc
loc
        If ExpBase Info VName
c ExpBase Info VName
texp ExpBase Info VName
fexp SrcLoc
loc ->
          ExpBase NoInfo VName
-> ExpBase NoInfo VName
-> ExpBase NoInfo VName
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn
-> ExpBase f vn -> ExpBase f vn -> SrcLoc -> AppExpBase f vn
If (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
c) (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
texp) (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
fexp) SrcLoc
loc
        Apply ExpBase Info VName
f NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
args SrcLoc
loc ->
          ExpBase NoInfo VName
-> NonEmpty (NoInfo (Diet, Maybe VName), ExpBase NoInfo VName)
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn
-> NonEmpty (f (Diet, Maybe VName), ExpBase f vn)
-> SrcLoc
-> AppExpBase f vn
Apply (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
f) (((Info (Diet, Maybe VName), ExpBase Info VName)
 -> (NoInfo (Diet, Maybe VName), ExpBase NoInfo VName))
-> NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
-> NonEmpty (NoInfo (Diet, Maybe VName), ExpBase NoInfo VName)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NoInfo (Diet, Maybe VName)
forall {k} (a :: k). NoInfo a
NoInfo,) (ExpBase NoInfo VName
 -> (NoInfo (Diet, Maybe VName), ExpBase NoInfo VName))
-> ((Info (Diet, Maybe VName), ExpBase Info VName)
    -> ExpBase NoInfo VName)
-> (Info (Diet, Maybe VName), ExpBase Info VName)
-> (NoInfo (Diet, Maybe VName), ExpBase NoInfo VName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpBase Info VName -> ExpBase NoInfo VName
bareExp (ExpBase Info VName -> ExpBase NoInfo VName)
-> ((Info (Diet, Maybe VName), ExpBase Info VName)
    -> ExpBase Info VName)
-> (Info (Diet, Maybe VName), ExpBase Info VName)
-> ExpBase NoInfo VName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Info (Diet, Maybe VName), ExpBase Info VName)
-> ExpBase Info VName
forall a b. (a, b) -> b
snd) NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
args) SrcLoc
loc
        LetPat [SizeBinder VName]
sizes PatBase Info VName StructType
pat ExpBase Info VName
e ExpBase Info VName
body SrcLoc
loc ->
          [SizeBinder VName]
-> PatBase NoInfo VName StructType
-> ExpBase NoInfo VName
-> ExpBase NoInfo VName
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
[SizeBinder vn]
-> PatBase f vn StructType
-> ExpBase f vn
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
LetPat [SizeBinder VName]
sizes (PatBase Info VName StructType -> PatBase NoInfo VName StructType
forall t. PatBase Info VName t -> PatBase NoInfo VName t
barePat PatBase Info VName StructType
pat) (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e) (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
body) SrcLoc
loc
        LetFun VName
name ([TypeParamBase VName]
fparams, [PatBase Info VName ParamType]
params, Maybe (TypeExp Info VName)
ret, Info ResRetType
_, ExpBase Info VName
e) ExpBase Info VName
body SrcLoc
loc ->
          VName
-> ([TypeParamBase VName], [PatBase NoInfo VName ParamType],
    Maybe (TypeExp NoInfo VName), NoInfo ResRetType,
    ExpBase NoInfo VName)
-> ExpBase NoInfo VName
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
vn
-> ([TypeParamBase vn], [PatBase f vn ParamType],
    Maybe (TypeExp f vn), f ResRetType, ExpBase f vn)
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
LetFun
            VName
name
            ([TypeParamBase VName]
fparams, (PatBase Info VName ParamType -> PatBase NoInfo VName ParamType)
-> [PatBase Info VName ParamType]
-> [PatBase NoInfo VName ParamType]
forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName ParamType -> PatBase NoInfo VName ParamType
forall t. PatBase Info VName t -> PatBase NoInfo VName t
barePat [PatBase Info VName ParamType]
params, (TypeExp Info VName -> TypeExp NoInfo VName)
-> Maybe (TypeExp Info VName) -> Maybe (TypeExp NoInfo VName)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeExp Info VName -> TypeExp NoInfo VName
bareTypeExp Maybe (TypeExp Info VName)
ret, NoInfo ResRetType
forall {k} (a :: k). NoInfo a
NoInfo, ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e)
            (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
body)
            SrcLoc
loc
        Range ExpBase Info VName
start Maybe (ExpBase Info VName)
next Inclusiveness (ExpBase Info VName)
end SrcLoc
loc ->
          ExpBase NoInfo VName
-> Maybe (ExpBase NoInfo VName)
-> Inclusiveness (ExpBase NoInfo VName)
-> SrcLoc
-> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn
-> Maybe (ExpBase f vn)
-> Inclusiveness (ExpBase f vn)
-> SrcLoc
-> AppExpBase f vn
Range (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
start) ((ExpBase Info VName -> ExpBase NoInfo VName)
-> Maybe (ExpBase Info VName) -> Maybe (ExpBase NoInfo VName)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExpBase Info VName -> ExpBase NoInfo VName
bareExp Maybe (ExpBase Info VName)
next) ((ExpBase Info VName -> ExpBase NoInfo VName)
-> Inclusiveness (ExpBase Info VName)
-> Inclusiveness (ExpBase NoInfo VName)
forall a b. (a -> b) -> Inclusiveness a -> Inclusiveness b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExpBase Info VName -> ExpBase NoInfo VName
bareExp Inclusiveness (ExpBase Info VName)
end) SrcLoc
loc
        Index ExpBase Info VName
arr SliceBase Info VName
slice SrcLoc
loc ->
          ExpBase NoInfo VName
-> SliceBase NoInfo VName -> SrcLoc -> AppExpBase NoInfo VName
forall (f :: * -> *) vn.
ExpBase f vn -> SliceBase f vn -> SrcLoc -> AppExpBase f vn
Index (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
arr) ((DimIndexBase Info VName -> DimIndexBase NoInfo VName)
-> SliceBase Info VName -> SliceBase NoInfo VName
forall a b. (a -> b) -> [a] -> [b]
map DimIndexBase Info VName -> DimIndexBase NoInfo VName
bareDimIndex SliceBase Info VName
slice) SrcLoc
loc
bareExp (Attr AttrInfo VName
attr ExpBase Info VName
e SrcLoc
loc) =
  AttrInfo VName
-> ExpBase NoInfo VName -> SrcLoc -> ExpBase NoInfo VName
forall (f :: * -> *) vn.
AttrInfo vn -> ExpBase f vn -> SrcLoc -> ExpBase f vn
Attr AttrInfo VName
attr (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
e) SrcLoc
loc