-- |
--
-- 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      mapOnName :: QualName VName -> m (QualName VName)
mapOnName = forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      mapOnStructType :: StructType -> m StructType
mapOnStructType = forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      mapOnParamType :: ParamType -> m ParamType
mapOnParamType = forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      mapOnResRetType :: ResRetType -> m ResRetType
mapOnResRetType = 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) =
    forall (f :: * -> *) vn.
ExpBase f vn
-> Maybe (ExpBase f vn)
-> Inclusiveness (ExpBase f vn)
-> SrcLoc
-> AppExpBase f vn
Range
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
start
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) Maybe (ExpBase Info VName)
next
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) Inclusiveness (ExpBase Info VName)
end
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
ExpBase f vn
-> ExpBase f vn -> ExpBase f vn -> SrcLoc -> AppExpBase f vn
If forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
texp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
fexp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
ExpBase f vn
-> NonEmpty (CaseBase f vn) -> SrcLoc -> AppExpBase f vn
Match forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv NonEmpty (CaseBase Info VName)
cases forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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' <- 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' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a b. (a -> b) -> a -> b
$ 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.
    forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
_ ->
        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 forall a. Semigroup a => a -> a -> a
<> NonEmpty (Info (Diet, Maybe VName), ExpBase Info VName)
args') SrcLoc
loc
      ExpBase 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) =
    forall (f :: * -> *) vn.
[SizeBinder vn]
-> PatBase f vn StructType
-> ExpBase f vn
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
LetPat [SizeBinder VName]
sizes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv PatBase Info VName StructType
pat forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
body forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    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
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ([TypeParamBase VName]
tparams,,,,)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv) [PatBase Info VName ParamType]
params
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv) Maybe (TypeExp Info VName)
ret
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> ResRetType -> m ResRetType
mapOnResRetType ASTMapper m
tv) Info ResRetType
t
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e
          )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
body
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    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
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv IdentBase Info VName StructType
dest
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv IdentBase Info VName StructType
src
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv) SliceBase Info VName
idxexps
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
vexp
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
body
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    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
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv QualName VName
fname forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
fname_loc)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Info (Maybe VName)
xext)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
y forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Info (Maybe VName)
yext)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
[VName]
-> PatBase f vn ParamType
-> ExpBase f vn
-> LoopFormBase f vn
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
Loop [VName]
sparams
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv PatBase Info VName ParamType
mergepat
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
mergeexp
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv LoopFormBase Info VName
form
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
loopbody
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
ExpBase f vn -> SliceBase f vn -> SrcLoc -> AppExpBase f vn
Index forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
arr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv) SliceBase Info VName
idxexps forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
QualName vn -> f StructType -> SrcLoc -> ExpBase f vn
Var
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv QualName VName
name
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Hole Info StructType
t SrcLoc
loc) =
    forall (f :: * -> *) vn. f StructType -> SrcLoc -> ExpBase f vn
Hole forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
_ (Literal PrimValue
val SrcLoc
loc) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. PrimValue -> SrcLoc -> ExpBase f vn
Literal PrimValue
val SrcLoc
loc
  astMap ASTMapper m
_ (StringLit [Word8]
vs SrcLoc
loc) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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) =
    forall (f :: * -> *) vn.
Integer -> f StructType -> SrcLoc -> ExpBase f vn
IntLit Integer
val forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (FloatLit Double
val Info StructType
t SrcLoc
loc) =
    forall (f :: * -> *) vn.
Double -> f StructType -> SrcLoc -> ExpBase f vn
FloatLit Double
val forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Parens ExpBase Info VName
e SrcLoc
loc) =
    forall (f :: * -> *) vn. ExpBase f vn -> SrcLoc -> ExpBase f vn
Parens forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
(QualName vn, SrcLoc) -> ExpBase f vn -> SrcLoc -> ExpBase f vn
QualParens
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv QualName VName
name forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
nameloc)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TupLit [ExpBase Info VName]
els SrcLoc
loc) =
    forall (f :: * -> *) vn. [ExpBase f vn] -> SrcLoc -> ExpBase f vn
TupLit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) [ExpBase Info VName]
els forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (RecordLit [FieldBase Info VName]
fields SrcLoc
loc) =
    forall (f :: * -> *) vn. [FieldBase f vn] -> SrcLoc -> ExpBase f vn
RecordLit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv [FieldBase Info VName]
fields forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
[ExpBase f vn] -> f StructType -> SrcLoc -> ExpBase f vn
ArrayLit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) [ExpBase Info VName]
els forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
ExpBase f vn -> TypeExp f vn -> SrcLoc -> ExpBase f vn
Ascript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv TypeExp Info VName
tdecl forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
ExpBase f vn
-> TypeExp f vn -> f StructType -> SrcLoc -> ExpBase f vn
Coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv TypeExp Info VName
tdecl forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Negate ExpBase Info VName
x SrcLoc
loc) =
    forall (f :: * -> *) vn. ExpBase f vn -> SrcLoc -> ExpBase f vn
Negate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (Not ExpBase Info VName
x SrcLoc
loc) =
    forall (f :: * -> *) vn. ExpBase f vn -> SrcLoc -> ExpBase f vn
Not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
ExpBase f vn
-> SliceBase f vn -> ExpBase f vn -> SrcLoc -> ExpBase f vn
Update
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
src
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv) SliceBase Info VName
slice
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
v
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
ExpBase f vn
-> [Name] -> ExpBase f vn -> f StructType -> SrcLoc -> ExpBase f vn
RecordUpdate
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
src
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Name]
fs
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
v
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. a -> Info a
Info forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv StructType
t)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
Name -> ExpBase f vn -> f StructType -> SrcLoc -> ExpBase f vn
Project Name
field forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
ExpBase f vn -> ExpBase f vn -> f Text -> SrcLoc -> ExpBase f vn
Assert forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Info Text
desc forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
[PatBase f vn ParamType]
-> ExpBase f vn
-> Maybe (TypeExp f vn)
-> f ResRetType
-> SrcLoc
-> ExpBase f vn
Lambda
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv) [PatBase Info VName ParamType]
params
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
body
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv) Maybe (TypeExp Info VName)
ret
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> ResRetType -> m ResRetType
mapOnResRetType ASTMapper m
tv) Info ResRetType
t
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (OpSection QualName VName
name Info StructType
t SrcLoc
loc) =
    forall (f :: * -> *) vn.
QualName vn -> f StructType -> SrcLoc -> ExpBase f vn
OpSection
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv QualName VName
name
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    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
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv QualName VName
name
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
arg
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( (,)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Info a
Info forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PName
pa,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). ASTMapper m -> ParamType -> m ParamType
mapOnParamType ASTMapper m
tv ParamType
t1a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VName
argext))
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. a -> Info a
Info forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PName
pb,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). ASTMapper m -> ParamType -> m ParamType
mapOnParamType ASTMapper m
tv ParamType
t1b))
          )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> ResRetType -> m ResRetType
mapOnResRetType ASTMapper m
tv) Info ResRetType
ret forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Info [VName]
retext)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    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
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv QualName VName
name
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
arg
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( (,)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Info a
Info forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PName
pa,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). ASTMapper m -> ParamType -> m ParamType
mapOnParamType ASTMapper m
tv ParamType
t1a))
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. a -> Info a
Info forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PName
pb,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). ASTMapper m -> ParamType -> m ParamType
mapOnParamType ASTMapper m
tv ParamType
t1b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VName
argext))
          )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> ResRetType -> m ResRetType
mapOnResRetType ASTMapper m
tv) Info ResRetType
t2
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (ProjectSection [Name]
fields Info StructType
t SrcLoc
loc) =
    forall (f :: * -> *) vn.
[Name] -> f StructType -> SrcLoc -> ExpBase f vn
ProjectSection [Name]
fields forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
SliceBase f vn -> f StructType -> SrcLoc -> ExpBase f vn
IndexSection
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv) SliceBase Info VName
idxs
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
Name -> [ExpBase f vn] -> f StructType -> SrcLoc -> ExpBase f vn
Constr Name
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) [ExpBase Info VName]
es forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
AttrInfo vn -> ExpBase f vn -> SrcLoc -> ExpBase f vn
Attr AttrInfo VName
attr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (AppExp AppExpBase Info VName
e Info AppRes
res) =
    forall (f :: * -> *) vn.
AppExpBase f vn -> f AppRes -> ExpBase f vn
AppExp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv AppExpBase Info VName
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
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) = forall (f :: * -> *) vn.
IdentBase f vn StructType -> ExpBase f vn -> LoopFormBase f vn
For forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv IdentBase Info VName StructType
i forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) = forall (f :: * -> *) vn.
PatBase f vn StructType -> ExpBase f vn -> LoopFormBase f vn
ForIn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv PatBase Info VName StructType
pat forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) = forall (f :: * -> *) vn. ExpBase f vn -> LoopFormBase f vn
While forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) =
    forall (f :: * -> *) vn. QualName vn -> SrcLoc -> TypeExp f vn
TEVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv QualName VName
qn forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TEParens TypeExp Info VName
te SrcLoc
loc) =
    forall (f :: * -> *) vn. TypeExp f vn -> SrcLoc -> TypeExp f vn
TEParens forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv TypeExp Info VName
te forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TETuple [TypeExp Info VName]
ts SrcLoc
loc) =
    forall (f :: * -> *) vn. [TypeExp f vn] -> SrcLoc -> TypeExp f vn
TETuple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv) [TypeExp Info VName]
ts forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TERecord [(Name, TypeExp Info VName)]
ts SrcLoc
loc) =
    forall (f :: * -> *) vn.
[(Name, TypeExp f vn)] -> SrcLoc -> TypeExp f vn
TERecord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a b. (a -> b) -> a -> b
$ forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv) [(Name, TypeExp Info VName)]
ts forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
SizeExp f vn -> TypeExp f vn -> SrcLoc -> TypeExp f vn
TEArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv SizeExp Info VName
te forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv TypeExp Info VName
dim forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TEUnique TypeExp Info VName
t SrcLoc
loc) =
    forall (f :: * -> *) vn. TypeExp f vn -> SrcLoc -> TypeExp f vn
TEUnique forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv TypeExp Info VName
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
TypeExp f vn -> TypeArgExp f vn -> SrcLoc -> TypeExp f vn
TEApply forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv TypeExp Info VName
t1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv TypeArgExp Info VName
t2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
Maybe vn -> TypeExp f vn -> TypeExp f vn -> SrcLoc -> TypeExp f vn
TEArrow Maybe VName
v forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv TypeExp Info VName
t1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv TypeExp Info VName
t2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TESum [(Name, [TypeExp Info VName])]
cs SrcLoc
loc) =
    forall (f :: * -> *) vn.
[(Name, [TypeExp f vn])] -> SrcLoc -> TypeExp f vn
TESum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a b. (a -> b) -> a -> b
$ forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv) [(Name, [TypeExp Info VName])]
cs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (TEDim [VName]
dims TypeExp Info VName
t SrcLoc
loc) =
    forall (f :: * -> *) vn.
[vn] -> TypeExp f vn -> SrcLoc -> TypeExp f vn
TEDim [VName]
dims forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv TypeExp Info VName
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) = forall (f :: * -> *) vn. SizeExp f vn -> TypeArgExp f vn
TypeArgExpSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv SizeExp Info VName
dim
  astMap ASTMapper m
tv (TypeArgExpType TypeExp Info VName
te) = forall (f :: * -> *) vn. TypeExp f vn -> TypeArgExp f vn
TypeArgExpType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
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) = forall (f :: * -> *) vn. ExpBase f vn -> SrcLoc -> SizeExp f vn
SizeExp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
_ (SizeExpAny SrcLoc
loc) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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) = forall (f :: * -> *) vn. ExpBase f vn -> DimIndexBase f vn
DimFix forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) =
    forall (f :: * -> *) vn.
Maybe (ExpBase f vn)
-> Maybe (ExpBase f vn)
-> Maybe (ExpBase f vn)
-> DimIndexBase f vn
DimSlice
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) Maybe (ExpBase Info VName)
i
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) Maybe (ExpBase Info VName)
j
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv StructType
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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) = forall dim u. Map Name (TypeBase dim u) -> ScalarTypeBase dim u
Record forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (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) =
  forall dim u.
u -> QualName VName -> [TypeArg dim] -> ScalarTypeBase dim u
TypeVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> als1 -> f als2
h als1
als forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QualName VName -> f (QualName VName)
f QualName VName
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (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)) =
  forall dim u.
u
-> PName
-> Diet
-> TypeBase dim NoUniqueness
-> RetTypeBase dim Uniqueness
-> ScalarTypeBase dim u
Arrow
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> als1 -> f als2
h als1
als
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure PName
v
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Diet
u
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeBase dim1 NoUniqueness
t1
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [VName]
dims forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 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) =
  forall dim u. Map Name [TypeBase dim u] -> ScalarTypeBase dim u
Sum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) (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) =
  forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> als1 -> f als2
h als1
als forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse dim1 -> f dims
g Shape dim1
shape forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 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) =
  forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) =
  forall dim. dim -> TypeArg dim
TypeArgDim 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) =
  forall dim. TypeBase dim NoUniqueness -> TypeArg dim
TypeArgType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 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 = forall (f :: * -> *) dim1 als1 dims als2.
Applicative f =>
TypeTraverser f TypeBase dim1 als1 dims als2
traverseType (forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv) (forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) 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 = forall (f :: * -> *) dim1 als1 dims als2.
Applicative f =>
TypeTraverser f TypeBase dim1 als1 dims als2
traverseType (forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv) (forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) 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 = forall (f :: * -> *) dim1 als1 dims als2.
Applicative f =>
TypeTraverser f TypeBase dim1 als1 dims als2
traverseType (forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv) (forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv) 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) = forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [VName]
ext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
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) =
    forall {k} (f :: k -> *) vn (t :: k).
vn -> f t -> SrcLoc -> IdentBase f vn t
Ident VName
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Info a
Info forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv StructType
t) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
  forall (f :: * -> *) vn t. vn -> f t -> SrcLoc -> PatBase f vn t
Id VName
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Info a
Info forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t1 -> m t2
f t1
t) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
traversePat t1 -> m t2
f (TuplePat [PatBase Info VName t1]
pats SrcLoc
loc) =
  forall (f :: * -> *) vn t.
[PatBase f vn t] -> SrcLoc -> PatBase f vn t
TuplePat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
  forall (f :: * -> *) vn t.
[(Name, PatBase f vn t)] -> SrcLoc -> PatBase f vn t
RecordPat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a b. (a -> b) -> a -> b
$ 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
traversePat t1 -> m t2
f (PatParens PatBase Info VName t1
pat SrcLoc
loc) =
  forall (f :: * -> *) vn t.
PatBase f vn t -> SrcLoc -> PatBase f vn t
PatParens forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
  forall (f :: * -> *) vn t.
PatBase f vn t -> TypeExp f vn -> SrcLoc -> PatBase f vn t
PatAscription forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeExp Info VName
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
traversePat t1 -> m t2
f (Wildcard (Info t1
t) SrcLoc
loc) =
  forall (f :: * -> *) vn t. f t -> SrcLoc -> PatBase f vn t
Wildcard forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Info a
Info forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t1 -> m t2
f t1
t) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
traversePat t1 -> m t2
f (PatLit PatLit
v (Info t1
t) SrcLoc
loc) =
  forall (f :: * -> *) vn t.
PatLit -> f t -> SrcLoc -> PatBase f vn t
PatLit PatLit
v forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Info a
Info forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t1 -> m t2
f t1
t) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
  forall (f :: * -> *) vn t.
Name -> f t -> [PatBase f vn t] -> SrcLoc -> PatBase f vn t
PatConstr Name
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Info a
Info forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t1 -> m t2
f t1
t) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
  forall (f :: * -> *) vn t.
AttrInfo vn -> PatBase f vn t -> SrcLoc -> PatBase f vn t
PatAttr AttrInfo VName
attr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = forall (m :: * -> *) t1 t2.
Monad m =>
(t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
traversePat forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *) t1 t2.
Monad m =>
(t1 -> m t2) -> PatBase Info VName t1 -> m (PatBase Info VName t2)
traversePat forall a b. (a -> b) -> a -> b
$ 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) =
    forall (f :: * -> *) vn.
Name -> ExpBase f vn -> SrcLoc -> FieldBase f vn
RecordFieldExplicit Name
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc
  astMap ASTMapper m
tv (RecordFieldImplicit VName
name Info StructType
t SrcLoc
loc) =
    forall (f :: * -> *) vn.
vn -> f StructType -> SrcLoc -> FieldBase f vn
RecordFieldImplicit
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall vn. QualName vn -> vn
qualLeaf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ASTMapper m -> QualName VName -> m (QualName VName)
mapOnName ASTMapper m
tv (forall vn. [vn] -> vn -> QualName vn
QualName [] VName
name))
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). ASTMapper m -> StructType -> m StructType
mapOnStructType ASTMapper m
tv) Info StructType
t
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
    forall (f :: * -> *) vn.
PatBase f vn StructType -> ExpBase f vn -> SrcLoc -> CaseBase f vn
CasePat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv PatBase Info VName StructType
pat forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
ASTMapper m -> ExpBase Info VName -> m (ExpBase Info VName)
mapOnExp ASTMapper m
tv ExpBase Info VName
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a b. (a -> b) -> a -> b
$ forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv

instance (ASTMappable a) => ASTMappable [a] where
  astMap :: forall (m :: * -> *). Monad m => ASTMapper m -> [a] -> m [a]
astMap ASTMapper m
tv = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a b. (a -> b) -> a -> b
$ forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
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 = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a b. (a -> b) -> a -> b
$ forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
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) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv a
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
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) = (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv a
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper m
tv b
y forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
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) =
  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) =
  forall (f :: * -> *) vn.
vn -> f StructType -> SrcLoc -> FieldBase f vn
RecordFieldImplicit VName
name 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) = forall (f :: * -> *) vn t.
[PatBase f vn t] -> SrcLoc -> PatBase f vn t
TuplePat (forall a b. (a -> b) -> [a] -> [b]
map 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) = forall (f :: * -> *) vn t.
[(Name, PatBase f vn t)] -> SrcLoc -> PatBase f vn t
RecordPat (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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) = forall (f :: * -> *) vn t.
PatBase f vn t -> SrcLoc -> PatBase f vn t
PatParens (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) = forall (f :: * -> *) vn t. vn -> f t -> SrcLoc -> PatBase f vn t
Id VName
v forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
barePat (Wildcard Info t
_ SrcLoc
loc) = forall (f :: * -> *) vn t. f t -> SrcLoc -> PatBase f vn t
Wildcard forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
barePat (PatAscription PatBase Info VName t
pat TypeExp Info VName
t SrcLoc
loc) = forall (f :: * -> *) vn t.
PatBase f vn t -> TypeExp f vn -> SrcLoc -> PatBase f vn t
PatAscription (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) = forall (f :: * -> *) vn t.
PatLit -> f t -> SrcLoc -> PatBase f vn t
PatLit PatLit
v forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
barePat (PatConstr Name
c Info t
_ [PatBase Info VName t]
ps SrcLoc
loc) = forall (f :: * -> *) vn t.
Name -> f t -> [PatBase f vn t] -> SrcLoc -> PatBase f vn t
PatConstr Name
c forall {k} (a :: k). NoInfo a
NoInfo (forall a b. (a -> b) -> [a] -> [b]
map 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) = forall (f :: * -> *) vn t.
AttrInfo vn -> PatBase f vn t -> SrcLoc -> PatBase f vn t
PatAttr AttrInfo VName
attr (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) =
  forall (f :: * -> *) vn. ExpBase f vn -> DimIndexBase f vn
DimFix 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) =
  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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ExpBase Info VName)
x) (ExpBase Info VName -> ExpBase NoInfo VName
bareExp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ExpBase Info VName)
y) (ExpBase Info VName -> ExpBase NoInfo VName
bareExp 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) = forall (f :: * -> *) vn.
IdentBase f vn StructType -> ExpBase f vn -> LoopFormBase f vn
For (forall {k} (f :: k -> *) vn (t :: k).
vn -> f t -> SrcLoc -> IdentBase f vn t
Ident VName
i 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) = forall (f :: * -> *) vn.
PatBase f vn StructType -> ExpBase f vn -> LoopFormBase f vn
ForIn (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) = 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) = forall (f :: * -> *) vn.
PatBase f vn StructType -> ExpBase f vn -> SrcLoc -> CaseBase f vn
CasePat (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) = 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) = 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) = forall (f :: * -> *) vn. QualName vn -> SrcLoc -> TypeExp f vn
TEVar QualName VName
qn SrcLoc
loc
bareTypeExp (TEParens TypeExp Info VName
te SrcLoc
loc) = 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) = forall (f :: * -> *) vn. [TypeExp f vn] -> SrcLoc -> TypeExp f vn
TETuple (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) = forall (f :: * -> *) vn.
[(Name, TypeExp f vn)] -> SrcLoc -> TypeExp f vn
TERecord (forall a b. (a -> b) -> [a] -> [b]
map (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) = 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) = 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) = 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) =
      forall (f :: * -> *) vn. SizeExp f vn -> TypeArgExp f vn
TypeArgExpSize forall a b. (a -> b) -> a -> b
$ SizeExp Info VName -> SizeExp NoInfo VName
bareSizeExp SizeExp Info VName
size
    bareTypeArgExp (TypeArgExpType TypeExp Info VName
tya) =
      forall (f :: * -> *) vn. TypeExp f vn -> TypeArgExp f vn
TypeArgExpType 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) = 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) = forall (f :: * -> *) vn.
[(Name, [TypeExp f vn])] -> SrcLoc -> TypeExp f vn
TESum (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a b. (a -> b) -> a -> b
$ 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) = 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) = forall (f :: * -> *) vn.
QualName vn -> f StructType -> SrcLoc -> ExpBase f vn
Var QualName VName
name forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Hole Info StructType
_ SrcLoc
loc) = forall (f :: * -> *) vn. f StructType -> SrcLoc -> ExpBase f vn
Hole forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Literal PrimValue
v SrcLoc
loc) = forall (f :: * -> *) vn. PrimValue -> SrcLoc -> ExpBase f vn
Literal PrimValue
v SrcLoc
loc
bareExp (IntLit Integer
val Info StructType
_ SrcLoc
loc) = forall (f :: * -> *) vn.
Integer -> f StructType -> SrcLoc -> ExpBase f vn
IntLit Integer
val forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (FloatLit Double
val Info StructType
_ SrcLoc
loc) = forall (f :: * -> *) vn.
Double -> f StructType -> SrcLoc -> ExpBase f vn
FloatLit Double
val forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Parens ExpBase Info VName
e SrcLoc
loc) = 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) = 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) = forall (f :: * -> *) vn. [ExpBase f vn] -> SrcLoc -> ExpBase f vn
TupLit (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) = forall (f :: * -> *) vn. [Word8] -> SrcLoc -> ExpBase f vn
StringLit [Word8]
vs SrcLoc
loc
bareExp (RecordLit [FieldBase Info VName]
fields SrcLoc
loc) = forall (f :: * -> *) vn. [FieldBase f vn] -> SrcLoc -> ExpBase f vn
RecordLit (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) = forall (f :: * -> *) vn.
[ExpBase f vn] -> f StructType -> SrcLoc -> ExpBase f vn
ArrayLit (forall a b. (a -> b) -> [a] -> [b]
map ExpBase Info VName -> ExpBase NoInfo VName
bareExp [ExpBase Info VName]
els) forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Ascript ExpBase Info VName
e TypeExp Info VName
te SrcLoc
loc) = 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) = 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) forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Negate ExpBase Info VName
x SrcLoc
loc) = 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) = 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) =
  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) (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) =
  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) forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Project Name
field ExpBase Info VName
e Info StructType
_ SrcLoc
loc) =
  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) forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Assert ExpBase Info VName
e1 ExpBase Info VName
e2 Info Text
_ SrcLoc
loc) = 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) 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) =
  forall (f :: * -> *) vn.
[PatBase f vn ParamType]
-> ExpBase f vn
-> Maybe (TypeExp f vn)
-> f ResRetType
-> SrcLoc
-> ExpBase f vn
Lambda (forall a b. (a -> b) -> [a] -> [b]
map 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) (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) forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (OpSection QualName VName
name Info StructType
_ SrcLoc
loc) = forall (f :: * -> *) vn.
QualName vn -> f StructType -> SrcLoc -> ExpBase f vn
OpSection QualName VName
name 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) =
  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 forall {k} (a :: k). NoInfo a
NoInfo (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
arg) (forall {k} (a :: k). NoInfo a
NoInfo, forall {k} (a :: k). NoInfo a
NoInfo) (forall {k} (a :: k). NoInfo a
NoInfo, 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) =
  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 forall {k} (a :: k). NoInfo a
NoInfo (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
arg) (forall {k} (a :: k). NoInfo a
NoInfo, forall {k} (a :: k). NoInfo a
NoInfo) forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (ProjectSection [Name]
fields Info StructType
_ SrcLoc
loc) = forall (f :: * -> *) vn.
[Name] -> f StructType -> SrcLoc -> ExpBase f vn
ProjectSection [Name]
fields forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (IndexSection SliceBase Info VName
slice Info StructType
_ SrcLoc
loc) =
  forall (f :: * -> *) vn.
SliceBase f vn -> f StructType -> SrcLoc -> ExpBase f vn
IndexSection (forall a b. (a -> b) -> [a] -> [b]
map DimIndexBase Info VName -> DimIndexBase NoInfo VName
bareDimIndex SliceBase Info VName
slice) forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (Constr Name
name [ExpBase Info VName]
es Info StructType
_ SrcLoc
loc) =
  forall (f :: * -> *) vn.
Name -> [ExpBase f vn] -> f StructType -> SrcLoc -> ExpBase f vn
Constr Name
name (forall a b. (a -> b) -> [a] -> [b]
map ExpBase Info VName -> ExpBase NoInfo VName
bareExp [ExpBase Info VName]
es) forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
loc
bareExp (AppExp AppExpBase Info VName
appexp Info AppRes
_) =
  forall (f :: * -> *) vn.
AppExpBase f vn -> f AppRes -> ExpBase f vn
AppExp AppExpBase NoInfo VName
appexp' 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 ->
          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) (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 ->
          forall (f :: * -> *) vn.
[VName]
-> PatBase f vn ParamType
-> ExpBase f vn
-> LoopFormBase f vn
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
Loop
            []
            (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 ->
          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
            (forall {k} (f :: k -> *) vn (t :: k).
vn -> f t -> SrcLoc -> IdentBase f vn t
Ident VName
dest forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
destloc)
            (forall {k} (f :: k -> *) vn (t :: k).
vn -> f t -> SrcLoc -> IdentBase f vn t
Ident VName
src forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
srcloc)
            (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 ->
          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 forall {k} (a :: k). NoInfo a
NoInfo (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
x, forall {k} (a :: k). NoInfo a
NoInfo) (ExpBase Info VName -> ExpBase NoInfo VName
bareExp ExpBase Info VName
y, forall {k} (a :: k). NoInfo a
NoInfo) SrcLoc
loc
        If ExpBase Info VName
c ExpBase Info VName
texp ExpBase Info VName
fexp SrcLoc
loc ->
          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 ->
          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) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall {k} (a :: k). NoInfo a
NoInfo,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpBase Info VName -> ExpBase NoInfo VName
bareExp forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 ->
          forall (f :: * -> *) vn.
[SizeBinder vn]
-> PatBase f vn StructType
-> ExpBase f vn
-> ExpBase f vn
-> SrcLoc
-> AppExpBase f vn
LetPat [SizeBinder VName]
sizes (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 ->
          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, forall a b. (a -> b) -> [a] -> [b]
map forall t. PatBase Info VName t -> PatBase NoInfo VName t
barePat [PatBase Info VName ParamType]
params, 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, 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 ->
          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) (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) (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 ->
          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) (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) =
  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