{-# Language ImplicitParams #-}
module Cryptol.IR.TraverseNames where

import Data.Set(Set)
import qualified Data.Set as Set
import Data.Functor.Identity

import Cryptol.ModuleSystem.Name(nameUnique)
import Cryptol.Utils.RecordMap(traverseRecordMap)
import Cryptol.Parser.Position(Located(..))
import Cryptol.TypeCheck.AST
import Cryptol.TypeCheck.FFI.FFIType

traverseNames ::
  (TraverseNames t, Applicative f) => (Name -> f Name) -> (t -> f t)
traverseNames :: forall t (f :: * -> *).
(TraverseNames t, Applicative f) =>
(Name -> f Name) -> t -> f t
traverseNames Name -> f Name
f = let ?name = Name -> f Name
f in forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP

mapNames :: (TraverseNames t) => (Name -> Name) -> t -> t
mapNames :: forall t. TraverseNames t => (Name -> Name) -> t -> t
mapNames Name -> Name
f t
x = t
result
  where
  Identity t
result = let ?name = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name
f
                    in forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP t
x

class TraverseNames t where
  traverseNamesIP :: (Applicative f, ?name :: Name -> f Name) => t -> f t

instance TraverseNames a => TraverseNames [a] where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
[a] -> f [a]
traverseNamesIP = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP

instance TraverseNames a => TraverseNames (Maybe a) where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
Maybe a -> f (Maybe a)
traverseNamesIP = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP

instance (Ord a, TraverseNames a) => TraverseNames (Set a) where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
Set a -> f (Set a)
traverseNamesIP = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList

instance TraverseNames a => TraverseNames (Located a) where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
Located a -> f (Located a)
traverseNamesIP (Located Range
r a
a) = forall a. Range -> a -> Located a
Located Range
r forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP a
a

instance TraverseNames Name where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
Name -> f Name
traverseNamesIP = ?name::Name -> f Name
?name

instance (Ord a, TraverseNames a) => TraverseNames (ExportSpec a) where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
ExportSpec a -> f (ExportSpec a)
traverseNamesIP (ExportSpec Map Namespace (Set a)
mp) = forall name. Map Namespace (Set name) -> ExportSpec name
ExportSpec 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 :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Map Namespace (Set a)
mp

instance TraverseNames Expr where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
Expr -> f Expr
traverseNamesIP Expr
expr =
    case Expr
expr of
      EList [Expr]
es Type
t        -> [Expr] -> Type -> Expr
EList  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP [Expr]
es forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Type
t

      ETuple [Expr]
es         -> [Expr] -> Expr
ETuple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP [Expr]
es

      ERec RecordMap Ident Expr
mp           -> RecordMap Ident Expr -> Expr
ERec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a b c.
Applicative t =>
(a -> b -> t c) -> RecordMap a b -> t (RecordMap a c)
traverseRecordMap (\Ident
_ -> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP) RecordMap Ident Expr
mp

      ESel Expr
e Selector
l          -> (Expr -> Selector -> Expr
`ESel` Selector
l) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e

      ESet Type
t Expr
e1 Selector
l Expr
e2    -> Type -> Expr -> Selector -> Expr -> Expr
ESet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Type
t
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e1
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Selector
l
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e2

      EIf Expr
e1 Expr
e2 Expr
e3      -> Expr -> Expr -> Expr -> Expr
EIf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e1
                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e2
                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e3

      EComp Type
t1 Type
t2 Expr
e [[Match]]
mss -> Type -> Type -> Expr -> [[Match]] -> Expr
EComp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Type
t1
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Type
t2
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP [[Match]]
mss

      EVar Name
x            -> Name -> Expr
EVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Name
x
      ETAbs TParam
tp Expr
e        -> TParam -> Expr -> Expr
ETAbs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP TParam
tp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e
      ETApp Expr
e Type
t         -> Expr -> Type -> Expr
ETApp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Type
t
      EApp Expr
e1 Expr
e2        -> Expr -> Expr -> Expr
EApp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e2
      EAbs Name
x Type
t Expr
e        -> Name -> Type -> Expr -> Expr
EAbs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Name
x
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Type
t
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e
      ELocated Range
r Expr
e      -> Range -> Expr -> Expr
ELocated Range
r forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e
      EProofAbs Type
p Expr
e     -> Type -> Expr -> Expr
EProofAbs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Type
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e
      EProofApp Expr
e       -> Expr -> Expr
EProofApp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e
      EWhere Expr
e [DeclGroup]
ds       -> Expr -> [DeclGroup] -> Expr
EWhere forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP [DeclGroup]
ds

      EPropGuards [([Type], Expr)]
gs Type
t  -> [([Type], Expr)] -> Type -> Expr
EPropGuards 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 :: * -> *} {a} {a}.
(Applicative f, ?name::Name -> f Name, TraverseNames a,
 TraverseNames a) =>
(a, a) -> f (a, a)
doG [([Type], Expr)]
gs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Type
t
        where doG :: (a, a) -> f (a, a)
doG (a
xs, a
e) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP a
xs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP a
e

instance TraverseNames Match where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
Match -> f Match
traverseNamesIP Match
mat =
    case Match
mat of
      From Name
x Type
t1 Type
t2 Expr
e -> Name -> Type -> Type -> Expr -> Match
From forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Name
x
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Type
t1
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Type
t2
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e
      Let Decl
d          -> Decl -> Match
Let forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Decl
d

instance TraverseNames DeclGroup where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
DeclGroup -> f DeclGroup
traverseNamesIP DeclGroup
dg =
    case DeclGroup
dg of
      NonRecursive Decl
d -> Decl -> DeclGroup
NonRecursive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Decl
d
      Recursive [Decl]
ds   -> [Decl] -> DeclGroup
Recursive    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP [Decl]
ds

instance TraverseNames Decl where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
Decl -> f Decl
traverseNamesIP Decl
decl = Name -> Schema -> DeclDef -> Decl
mk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (Decl -> Name
dName Decl
decl)
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (Decl -> Schema
dSignature Decl
decl)
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (Decl -> DeclDef
dDefinition Decl
decl)
    where mk :: Name -> Schema -> DeclDef -> Decl
mk Name
nm Schema
sig DeclDef
def = Decl
decl { dName :: Name
dName = Name
nm
                               , dSignature :: Schema
dSignature = Schema
sig
                               , dDefinition :: DeclDef
dDefinition = DeclDef
def
                               }

instance TraverseNames DeclDef where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
DeclDef -> f DeclDef
traverseNamesIP DeclDef
d =
    case DeclDef
d of
      DeclDef
DPrim   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DeclDef
d
      DForeign FFIFunType
t -> FFIFunType -> DeclDef
DForeign forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP FFIFunType
t
      DExpr Expr
e -> Expr -> DeclDef
DExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Expr
e

instance TraverseNames Schema where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
Schema -> f Schema
traverseNamesIP (Forall [TParam]
as [Type]
ps Type
t) =
    [TParam] -> [Type] -> Type -> Schema
Forall forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP [TParam]
as
           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP [Type]
ps
           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Type
t

instance TraverseNames TParam where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
TParam -> f TParam
traverseNamesIP TParam
tp = TPFlavor -> TVarInfo -> TParam
mk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (TParam -> TPFlavor
tpFlav TParam
tp)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (TParam -> TVarInfo
tpInfo TParam
tp)
    -- XXX: module parameters should probably be represented directly
    -- as (abstract) user-defined types, rather than type variables.
    where mk :: TPFlavor -> TVarInfo -> TParam
mk TPFlavor
f TVarInfo
i = case TPFlavor
f of
                     TPModParam Name
x ->
                      TParam
tp { tpUnique :: Int
tpUnique = Name -> Int
nameUnique Name
x, tpFlav :: TPFlavor
tpFlav = TPFlavor
f, tpInfo :: TVarInfo
tpInfo = TVarInfo
i }
                     TPFlavor
_ -> TParam
tp { tpFlav :: TPFlavor
tpFlav = TPFlavor
f, tpInfo :: TVarInfo
tpInfo = TVarInfo
i }


instance TraverseNames TPFlavor where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
TPFlavor -> f TPFlavor
traverseNamesIP TPFlavor
tpf =
    case TPFlavor
tpf of
      TPModParam Name
x      -> Name -> TPFlavor
TPModParam     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Name
x
      TPFlavor
TPUnifyVar        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TPFlavor
tpf
      TPSchemaParam Name
x   -> Name -> TPFlavor
TPSchemaParam  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Name
x
      TPTySynParam Name
x    -> Name -> TPFlavor
TPTySynParam   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Name
x
      TPPropSynParam Name
x  -> Name -> TPFlavor
TPPropSynParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Name
x
      TPNewtypeParam Name
x  -> Name -> TPFlavor
TPNewtypeParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Name
x
      TPPrimParam Name
x     -> Name -> TPFlavor
TPPrimParam    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Name
x

instance TraverseNames TVarInfo where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
TVarInfo -> f TVarInfo
traverseNamesIP (TVarInfo Range
r TypeSource
s) = Range -> TypeSource -> TVarInfo
TVarInfo Range
r forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP TypeSource
s

instance TraverseNames TypeSource where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
TypeSource -> f TypeSource
traverseNamesIP TypeSource
src =
    case TypeSource
src of
      TVFromModParam Name
x            -> Name -> TypeSource
TVFromModParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Name
x
      TVFromSignature Name
x           -> Name -> TypeSource
TVFromSignature forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Name
x
      TypeSource
TypeWildCard                -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSource
src
      TypeOfRecordField {}        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSource
src
      TypeOfTupleField {}         -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSource
src
      TypeSource
TypeOfSeqElement            -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSource
src
      TypeSource
LenOfSeq                    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSource
src
      TypeParamInstNamed Name
x Ident
i      -> Name -> Ident -> TypeSource
TypeParamInstNamed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Name
x
                                                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Ident
i
      TypeParamInstPos   Name
x Int
i      -> Name -> Int -> TypeSource
TypeParamInstPos   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Name
x
                                                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
      DefinitionOf Name
x              -> Name -> TypeSource
DefinitionOf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Name
x
      TypeSource
LenOfCompGen                -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSource
src
      TypeOfArg ArgDescr
arg               -> ArgDescr -> TypeSource
TypeOfArg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP ArgDescr
arg
      TypeSource
TypeOfRes                   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSource
src
      TypeSource
FunApp                      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSource
src
      TypeSource
TypeOfIfCondExpr            -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSource
src
      TypeSource
TypeFromUserAnnotation      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSource
src
      TypeSource
GeneratorOfListComp         -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSource
src
      TypeSource
TypeErrorPlaceHolder        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSource
src

instance TraverseNames ArgDescr where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
ArgDescr -> f ArgDescr
traverseNamesIP ArgDescr
arg = Maybe Name -> ArgDescr
mk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (ArgDescr -> Maybe Name
argDescrFun ArgDescr
arg)
    where mk :: Maybe Name -> ArgDescr
mk Maybe Name
n = ArgDescr
arg { argDescrFun :: Maybe Name
argDescrFun = Maybe Name
n }

instance TraverseNames Type where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
Type -> f Type
traverseNamesIP Type
ty =
    case Type
ty of
      TCon TCon
tc [Type]
ts    -> TCon -> [Type] -> Type
TCon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP TCon
tc forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP [Type]
ts
      TVar TVar
x        -> TVar -> Type
TVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP TVar
x
      TUser Name
x [Type]
ts Type
t  -> Name -> [Type] -> Type -> Type
TUser forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Name
x
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP [Type]
ts
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Type
t
      TRec RecordMap Ident Type
rm       -> RecordMap Ident Type -> Type
TRec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a b c.
Applicative t =>
(a -> b -> t c) -> RecordMap a b -> t (RecordMap a c)
traverseRecordMap (\Ident
_ -> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP) RecordMap Ident Type
rm
      TNewtype Newtype
nt [Type]
ts -> Newtype -> [Type] -> Type
TNewtype forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Newtype
nt forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP [Type]
ts


instance TraverseNames TCon where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
TCon -> f TCon
traverseNamesIP TCon
tcon =
    case TCon
tcon of
      TC TC
tc -> TC -> TCon
TC forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP TC
tc
      TCon
_     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TCon
tcon

instance TraverseNames TC where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
TC -> f TC
traverseNamesIP TC
tc =
    case TC
tc of
      TCAbstract UserTC
ut -> UserTC -> TC
TCAbstract forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP UserTC
ut
      TC
_             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TC
tc

instance TraverseNames UserTC where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
UserTC -> f UserTC
traverseNamesIP (UserTC Name
x Kind
k) = Name -> Kind -> UserTC
UserTC forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Name
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
k

instance TraverseNames TVar where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
TVar -> f TVar
traverseNamesIP TVar
tvar =
    case TVar
tvar of
      TVFree Int
x Kind
k Set TParam
ys TVarInfo
i -> Int -> Kind -> Set TParam -> TVarInfo -> TVar
TVFree Int
x Kind
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP Set TParam
ys forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP TVarInfo
i
      TVBound TParam
x       -> TParam -> TVar
TVBound forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP TParam
x

instance TraverseNames Newtype where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
Newtype -> f Newtype
traverseNamesIP Newtype
nt = Name
-> [TParam] -> [Type] -> Name -> RecordMap Ident Type -> Newtype
mk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (Newtype -> Name
ntName Newtype
nt)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (Newtype -> [TParam]
ntParams Newtype
nt)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (Newtype -> [Type]
ntConstraints Newtype
nt)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (Newtype -> Name
ntConName Newtype
nt)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) a b c.
Applicative t =>
(a -> b -> t c) -> RecordMap a b -> t (RecordMap a c)
traverseRecordMap (\Ident
_ -> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP)
                                                (Newtype -> RecordMap Ident Type
ntFields Newtype
nt)
    where
    mk :: Name
-> [TParam] -> [Type] -> Name -> RecordMap Ident Type -> Newtype
mk Name
a [TParam]
b [Type]
c Name
d RecordMap Ident Type
e = Newtype
nt { ntName :: Name
ntName = Name
a
                      , ntParams :: [TParam]
ntParams = [TParam]
b
                      , ntConstraints :: [Type]
ntConstraints = [Type]
c
                      , ntConName :: Name
ntConName = Name
d
                      , ntFields :: RecordMap Ident Type
ntFields = RecordMap Ident Type
e
                      }

instance TraverseNames ModTParam where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
ModTParam -> f ModTParam
traverseNamesIP ModTParam
nt = Name -> ModTParam
mk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (ModTParam -> Name
mtpName ModTParam
nt)
    where
    mk :: Name -> ModTParam
mk Name
x = ModTParam
nt { mtpName :: Name
mtpName = Name
x }

instance TraverseNames ModVParam where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
ModVParam -> f ModVParam
traverseNamesIP ModVParam
nt = Name -> Schema -> ModVParam
mk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (ModVParam -> Name
mvpName ModVParam
nt)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (ModVParam -> Schema
mvpType ModVParam
nt)
    where
    mk :: Name -> Schema -> ModVParam
mk Name
x Schema
t = ModVParam
nt { mvpName :: Name
mvpName = Name
x, mvpType :: Schema
mvpType = Schema
t }

instance TraverseNames FFIFunType where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
FFIFunType -> f FFIFunType
traverseNamesIP FFIFunType
fi = [FFIType] -> FFIType -> FFIFunType
mk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (FFIFunType -> [FFIType]
ffiArgTypes FFIFunType
fi)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (FFIFunType -> FFIType
ffiRetType FFIFunType
fi)
    where
    mk :: [FFIType] -> FFIType -> FFIFunType
mk [FFIType]
as FFIType
b =
      FFIFunType
        { ffiTParams :: [TParam]
ffiTParams  = FFIFunType -> [TParam]
ffiTParams FFIFunType
fi
        , ffiArgTypes :: [FFIType]
ffiArgTypes = [FFIType]
as
        , ffiRetType :: FFIType
ffiRetType  = FFIType
b
        }

instance TraverseNames FFIType where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
FFIType -> f FFIType
traverseNamesIP FFIType
ft =
    case FFIType
ft of
      FFIType
FFIBool       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure FFIType
ft
      FFIBasic FFIBasicType
_    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure FFIType
ft   -- assumes no names here
      FFIArray [Type]
sz FFIBasicType
t -> ([Type] -> FFIBasicType -> FFIType
`FFIArray` FFIBasicType
t) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP [Type]
sz
      FFITuple [FFIType]
ts   -> [FFIType] -> FFIType
FFITuple  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP [FFIType]
ts
      FFIRecord RecordMap Ident FFIType
mp  -> RecordMap Ident FFIType -> FFIType
FFIRecord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a b c.
Applicative t =>
(a -> b -> t c) -> RecordMap a b -> t (RecordMap a c)
traverseRecordMap
                                                (\Ident
_ -> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP) RecordMap Ident FFIType
mp
instance TraverseNames TySyn where
  traverseNamesIP :: forall (f :: * -> *).
(Applicative f, ?name::Name -> f Name) =>
TySyn -> f TySyn
traverseNamesIP TySyn
ts = Name -> [TParam] -> [Type] -> Type -> TySyn
mk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (TySyn -> Name
tsName TySyn
ts)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (TySyn -> [TParam]
tsParams TySyn
ts)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (TySyn -> [Type]
tsConstraints TySyn
ts)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t (f :: * -> *).
(TraverseNames t, Applicative f, ?name::Name -> f Name) =>
t -> f t
traverseNamesIP (TySyn -> Type
tsDef TySyn
ts)
    where mk :: Name -> [TParam] -> [Type] -> Type -> TySyn
mk Name
n [TParam]
ps [Type]
cs Type
t =
            TySyn  { tsName :: Name
tsName        = Name
n
                   , tsParams :: [TParam]
tsParams      = [TParam]
ps
                   , tsConstraints :: [Type]
tsConstraints = [Type]
cs
                   , tsDef :: Type
tsDef         = Type
t
                   , tsDoc :: Maybe Text
tsDoc         = TySyn -> Maybe Text
tsDoc TySyn
ts
                   }