-- |
-- Module      :  Cryptol.ModuleSystem.Renamer
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Cryptol.ModuleSystem.Renamer (
    NamingEnv(), shadowing
  , BindsNames(..), InModule(..), namingEnv'
  , checkNamingEnv
  , shadowNames
  , Rename(..), runRenamer, RenameM()
  , RenamerError(..)
  , RenamerWarning(..)
  , renameVar
  , renameType
  , renameModule
  ) where

import Cryptol.ModuleSystem.Name
import Cryptol.ModuleSystem.NamingEnv
import Cryptol.ModuleSystem.Exports
import Cryptol.Parser.AST
import Cryptol.Parser.Position
import Cryptol.Parser.Selector(ppNestedSels,selName)
import Cryptol.Utils.Panic (panic)
import Cryptol.Utils.PP
import Cryptol.Utils.RecordMap

import Data.List(find)
import qualified Data.Foldable as F
import           Data.Map.Strict ( Map )
import qualified Data.Map.Strict as Map
import qualified Data.Sequence as Seq
import qualified Data.Semigroup as S
import           Data.Set (Set)
import qualified Data.Set as Set
import           MonadLib hiding (mapM, mapM_)

import GHC.Generics (Generic)
import Control.DeepSeq

import Prelude ()
import Prelude.Compat

-- Errors ----------------------------------------------------------------------

data RenamerError
  = MultipleSyms (Located PName) [Name] NameDisp
    -- ^ Multiple imported symbols contain this name

  | UnboundExpr (Located PName) NameDisp
    -- ^ Expression name is not bound to any definition

  | UnboundType (Located PName) NameDisp
    -- ^ Type name is not bound to any definition

  | OverlappingSyms [Name] NameDisp
    -- ^ An environment has produced multiple overlapping symbols

  | ExpectedValue (Located PName) NameDisp
    -- ^ When a value is expected from the naming environment, but one or more
    -- types exist instead.

  | ExpectedType (Located PName) NameDisp
    -- ^ When a type is missing from the naming environment, but one or more
    -- values exist with the same name.

  | FixityError (Located Name) Fixity (Located Name) Fixity NameDisp
    -- ^ When the fixity of two operators conflict

  | InvalidConstraint (Type PName) NameDisp
    -- ^ When it's not possible to produce a Prop from a Type.

  | MalformedBuiltin (Type PName) PName NameDisp
    -- ^ When a builtin type/type-function is used incorrectly.

  | BoundReservedType PName (Maybe Range) Doc NameDisp
    -- ^ When a builtin type is named in a binder.

  | OverlappingRecordUpdate (Located [Selector]) (Located [Selector]) NameDisp
    -- ^ When record updates overlap (e.g., @{ r | x = e1, x.y = e2 }@)
    deriving (Int -> RenamerError -> ShowS
[RenamerError] -> ShowS
RenamerError -> String
(Int -> RenamerError -> ShowS)
-> (RenamerError -> String)
-> ([RenamerError] -> ShowS)
-> Show RenamerError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenamerError] -> ShowS
$cshowList :: [RenamerError] -> ShowS
show :: RenamerError -> String
$cshow :: RenamerError -> String
showsPrec :: Int -> RenamerError -> ShowS
$cshowsPrec :: Int -> RenamerError -> ShowS
Show, (forall x. RenamerError -> Rep RenamerError x)
-> (forall x. Rep RenamerError x -> RenamerError)
-> Generic RenamerError
forall x. Rep RenamerError x -> RenamerError
forall x. RenamerError -> Rep RenamerError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RenamerError x -> RenamerError
$cfrom :: forall x. RenamerError -> Rep RenamerError x
Generic, RenamerError -> ()
(RenamerError -> ()) -> NFData RenamerError
forall a. (a -> ()) -> NFData a
rnf :: RenamerError -> ()
$crnf :: RenamerError -> ()
NFData)

instance PP RenamerError where
  ppPrec :: Int -> RenamerError -> Doc
ppPrec Int
_ RenamerError
e = case RenamerError
e of

    MultipleSyms Located PName
lqn [Name]
qns NameDisp
disp -> NameDisp -> Doc -> Doc
fixNameDisp NameDisp
disp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[error] at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> Range
forall a. Located a -> Range
srcRange Located PName
lqn))
         Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc
text String
"Multiple definitions for symbol:" Doc -> Doc -> Doc
<+> PName -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> PName
forall a. Located a -> a
thing Located PName
lqn))
          Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
ppLocName [Name]
qns)

    UnboundExpr Located PName
lqn NameDisp
disp -> NameDisp -> Doc -> Doc
fixNameDisp NameDisp
disp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[error] at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> Range
forall a. Located a -> Range
srcRange Located PName
lqn))
         Int
4 (String -> Doc
text String
"Value not in scope:" Doc -> Doc -> Doc
<+> PName -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> PName
forall a. Located a -> a
thing Located PName
lqn))

    UnboundType Located PName
lqn NameDisp
disp -> NameDisp -> Doc -> Doc
fixNameDisp NameDisp
disp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[error] at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> Range
forall a. Located a -> Range
srcRange Located PName
lqn))
         Int
4 (String -> Doc
text String
"Type not in scope:" Doc -> Doc -> Doc
<+> PName -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> PName
forall a. Located a -> a
thing Located PName
lqn))

    OverlappingSyms [Name]
qns NameDisp
disp -> NameDisp -> Doc -> Doc
fixNameDisp NameDisp
disp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[error]")
         Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Overlapping symbols defined:"
          Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
ppLocName [Name]
qns)

    ExpectedValue Located PName
lqn NameDisp
disp -> NameDisp -> Doc -> Doc
fixNameDisp NameDisp
disp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[error] at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> Range
forall a. Located a -> Range
srcRange Located PName
lqn))
         Int
4 ([Doc] -> Doc
fsep [ String -> Doc
text String
"Expected a value named", Doc -> Doc
quotes (PName -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> PName
forall a. Located a -> a
thing Located PName
lqn))
                 , String -> Doc
text String
"but found a type instead"
                 , String -> Doc
text String
"Did you mean `(" Doc -> Doc -> Doc
<.> PName -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> PName
forall a. Located a -> a
thing Located PName
lqn) Doc -> Doc -> Doc
<.> String -> Doc
textString
")?" ])

    ExpectedType Located PName
lqn NameDisp
disp -> NameDisp -> Doc -> Doc
fixNameDisp NameDisp
disp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[error] at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> Range
forall a. Located a -> Range
srcRange Located PName
lqn))
         Int
4 ([Doc] -> Doc
fsep [ String -> Doc
text String
"Expected a type named", Doc -> Doc
quotes (PName -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> PName
forall a. Located a -> a
thing Located PName
lqn))
                 , String -> Doc
text String
"but found a value instead" ])

    FixityError Located Name
o1 Fixity
f1 Located Name
o2 Fixity
f2 NameDisp
disp -> NameDisp -> Doc -> Doc
fixNameDisp NameDisp
disp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[error] at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located Name -> Range
forall a. Located a -> Range
srcRange Located Name
o1) Doc -> Doc -> Doc
<+> String -> Doc
text String
"and" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located Name -> Range
forall a. Located a -> Range
srcRange Located Name
o2))
         Int
4 ([Doc] -> Doc
fsep [ String -> Doc
text String
"The fixities of"
                 , Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
                   [ Doc
"•" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. PP a => a -> Doc
pp (Located Name -> Name
forall a. Located a -> a
thing Located Name
o1) Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Fixity -> Doc
forall a. PP a => a -> Doc
pp Fixity
f1)
                   , Doc
"•" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. PP a => a -> Doc
pp (Located Name -> Name
forall a. Located a -> a
thing Located Name
o2) Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Fixity -> Doc
forall a. PP a => a -> Doc
pp Fixity
f2) ]
                 , String -> Doc
text String
"are not compatible."
                 , String -> Doc
text String
"You may use explicit parentheses to disambiguate." ])

    InvalidConstraint Type PName
ty NameDisp
disp -> NameDisp -> Doc -> Doc
fixNameDisp NameDisp
disp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[error]" Doc -> Doc -> Doc
<+> Doc -> (Range -> Doc) -> Maybe Range -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\Range
r -> String -> Doc
text String
"at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp Range
r) (Type PName -> Maybe Range
forall t. HasLoc t => t -> Maybe Range
getLoc Type PName
ty))
         Int
4 ([Doc] -> Doc
fsep [ Type PName -> Doc
forall a. PP a => a -> Doc
pp Type PName
ty, String -> Doc
text String
"is not a valid constraint" ])

    MalformedBuiltin Type PName
ty PName
pn NameDisp
disp -> NameDisp -> Doc -> Doc
fixNameDisp NameDisp
disp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[error]" Doc -> Doc -> Doc
<+> Doc -> (Range -> Doc) -> Maybe Range -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\Range
r -> String -> Doc
text String
"at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp Range
r) (Type PName -> Maybe Range
forall t. HasLoc t => t -> Maybe Range
getLoc Type PName
ty))
         Int
4 ([Doc] -> Doc
fsep [ String -> Doc
text String
"invalid use of built-in type", PName -> Doc
forall a. PP a => a -> Doc
pp PName
pn
                 , String -> Doc
text String
"in type", Type PName -> Doc
forall a. PP a => a -> Doc
pp Type PName
ty ])

    BoundReservedType PName
n Maybe Range
loc Doc
src NameDisp
disp -> NameDisp -> Doc -> Doc
fixNameDisp NameDisp
disp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[error]" Doc -> Doc -> Doc
<+> Doc -> (Range -> Doc) -> Maybe Range -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\Range
r -> String -> Doc
text String
"at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp Range
r) Maybe Range
loc)
         Int
4 ([Doc] -> Doc
fsep [ String -> Doc
text String
"built-in type", Doc -> Doc
quotes (PName -> Doc
forall a. PP a => a -> Doc
pp PName
n), String -> Doc
text String
"shadowed in", Doc
src ])

    OverlappingRecordUpdate Located [Selector]
xs Located [Selector]
ys NameDisp
disp -> NameDisp -> Doc -> Doc
fixNameDisp NameDisp
disp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc -> Int -> Doc -> Doc
hang Doc
"[error] Overlapping record updates:"
         Int
4 ([Doc] -> Doc
vcat [ Located [Selector] -> Doc
ppLab Located [Selector]
xs, Located [Selector] -> Doc
ppLab Located [Selector]
ys ])
      where
      ppLab :: Located [Selector] -> Doc
ppLab Located [Selector]
as = [Selector] -> Doc
ppNestedSels (Located [Selector] -> [Selector]
forall a. Located a -> a
thing Located [Selector]
as) Doc -> Doc -> Doc
<+> Doc
"at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located [Selector] -> Range
forall a. Located a -> Range
srcRange Located [Selector]
as)

-- Warnings --------------------------------------------------------------------

data RenamerWarning
  = SymbolShadowed Name [Name] NameDisp

  | UnusedName Name NameDisp
    deriving (Int -> RenamerWarning -> ShowS
[RenamerWarning] -> ShowS
RenamerWarning -> String
(Int -> RenamerWarning -> ShowS)
-> (RenamerWarning -> String)
-> ([RenamerWarning] -> ShowS)
-> Show RenamerWarning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenamerWarning] -> ShowS
$cshowList :: [RenamerWarning] -> ShowS
show :: RenamerWarning -> String
$cshow :: RenamerWarning -> String
showsPrec :: Int -> RenamerWarning -> ShowS
$cshowsPrec :: Int -> RenamerWarning -> ShowS
Show, (forall x. RenamerWarning -> Rep RenamerWarning x)
-> (forall x. Rep RenamerWarning x -> RenamerWarning)
-> Generic RenamerWarning
forall x. Rep RenamerWarning x -> RenamerWarning
forall x. RenamerWarning -> Rep RenamerWarning x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RenamerWarning x -> RenamerWarning
$cfrom :: forall x. RenamerWarning -> Rep RenamerWarning x
Generic, RenamerWarning -> ()
(RenamerWarning -> ()) -> NFData RenamerWarning
forall a. (a -> ()) -> NFData a
rnf :: RenamerWarning -> ()
$crnf :: RenamerWarning -> ()
NFData)

instance PP RenamerWarning where
  ppPrec :: Int -> RenamerWarning -> Doc
ppPrec Int
_ (SymbolShadowed Name
new [Name]
originals NameDisp
disp) = NameDisp -> Doc -> Doc
fixNameDisp NameDisp
disp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[warning] at" Doc -> Doc -> Doc
<+> Doc
loc)
       Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep [ String -> Doc
text String
"This binding for" Doc -> Doc -> Doc
<+> Doc -> Doc
backticks Doc
sym
                , String -> Doc
text String
"shadows the existing binding" Doc -> Doc -> Doc
<.> Doc
plural Doc -> Doc -> Doc
<+>
                  String -> Doc
text String
"at" ]
        Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Range -> Doc
forall a. PP a => a -> Doc
pp (Range -> Doc) -> (Name -> Range) -> Name -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Range
nameLoc) [Name]
originals)

    where
    plural :: Doc
plural | [Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
originals Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = Char -> Doc
char Char
's'
           | Bool
otherwise            = Doc
empty

    loc :: Doc
loc = Range -> Doc
forall a. PP a => a -> Doc
pp (Name -> Range
nameLoc Name
new)
    sym :: Doc
sym = Name -> Doc
forall a. PP a => a -> Doc
pp Name
new

  ppPrec Int
_ (UnusedName Name
x NameDisp
disp) = NameDisp -> Doc -> Doc
fixNameDisp NameDisp
disp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"[warning] at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Name -> Range
nameLoc Name
x))
       Int
4 (String -> Doc
text String
"Unused name:" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. PP a => a -> Doc
pp Name
x)


data RenamerWarnings = RenamerWarnings
  { RenamerWarnings -> NameDisp
renWarnNameDisp :: !NameDisp
  , RenamerWarnings -> Map Name (Set Name)
renWarnShadow   :: Map Name (Set Name)
  , RenamerWarnings -> Set Name
renWarnUnused   :: Set Name
  }

noRenamerWarnings :: RenamerWarnings
noRenamerWarnings :: RenamerWarnings
noRenamerWarnings = RenamerWarnings :: NameDisp -> Map Name (Set Name) -> Set Name -> RenamerWarnings
RenamerWarnings
  { renWarnNameDisp :: NameDisp
renWarnNameDisp = NameDisp
forall a. Monoid a => a
mempty
  , renWarnShadow :: Map Name (Set Name)
renWarnShadow   = Map Name (Set Name)
forall k a. Map k a
Map.empty
  , renWarnUnused :: Set Name
renWarnUnused   = Set Name
forall a. Set a
Set.empty
  }

addRenamerWarning :: RenamerWarning -> RenamerWarnings -> RenamerWarnings
addRenamerWarning :: RenamerWarning -> RenamerWarnings -> RenamerWarnings
addRenamerWarning RenamerWarning
w RenamerWarnings
ws =
  case RenamerWarning
w of
    SymbolShadowed Name
x [Name]
xs NameDisp
d ->
      RenamerWarnings
ws { renWarnNameDisp :: NameDisp
renWarnNameDisp = RenamerWarnings -> NameDisp
renWarnNameDisp RenamerWarnings
ws NameDisp -> NameDisp -> NameDisp
forall a. Semigroup a => a -> a -> a
<> NameDisp
d
         , renWarnShadow :: Map Name (Set Name)
renWarnShadow   = (Set Name -> Set Name -> Set Name)
-> Name -> Set Name -> Map Name (Set Name) -> Map Name (Set Name)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
Set.union Name
x ([Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList [Name]
xs)
                                                        (RenamerWarnings -> Map Name (Set Name)
renWarnShadow RenamerWarnings
ws)
         }
    UnusedName Name
x NameDisp
d ->
      RenamerWarnings
ws { renWarnNameDisp :: NameDisp
renWarnNameDisp = RenamerWarnings -> NameDisp
renWarnNameDisp RenamerWarnings
ws NameDisp -> NameDisp -> NameDisp
forall a. Semigroup a => a -> a -> a
<> NameDisp
d
         , renWarnUnused :: Set Name
renWarnUnused   = Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
Set.insert Name
x (RenamerWarnings -> Set Name
renWarnUnused RenamerWarnings
ws)
         }

listRenamerWarnings :: RenamerWarnings -> [RenamerWarning]
listRenamerWarnings :: RenamerWarnings -> [RenamerWarning]
listRenamerWarnings RenamerWarnings
ws =
  [ (NameDisp -> RenamerWarning) -> RenamerWarning
forall t. (NameDisp -> t) -> t
mk (Name -> NameDisp -> RenamerWarning
UnusedName Name
x) | Name
x      <- Set Name -> [Name]
forall a. Set a -> [a]
Set.toList (RenamerWarnings -> Set Name
renWarnUnused RenamerWarnings
ws) ] [RenamerWarning] -> [RenamerWarning] -> [RenamerWarning]
forall a. [a] -> [a] -> [a]
++
  [ (NameDisp -> RenamerWarning) -> RenamerWarning
forall t. (NameDisp -> t) -> t
mk (Name -> [Name] -> NameDisp -> RenamerWarning
SymbolShadowed Name
x (Set Name -> [Name]
forall a. Set a -> [a]
Set.toList Set Name
xs))
          | (Name
x,Set Name
xs) <- Map Name (Set Name) -> [(Name, Set Name)]
forall k a. Map k a -> [(k, a)]
Map.toList (RenamerWarnings -> Map Name (Set Name)
renWarnShadow RenamerWarnings
ws) ]
  where
  mk :: (NameDisp -> t) -> t
mk NameDisp -> t
f = NameDisp -> t
f (RenamerWarnings -> NameDisp
renWarnNameDisp RenamerWarnings
ws)


-- Renaming Monad --------------------------------------------------------------

data RO = RO
  { RO -> Range
roLoc   :: Range
  , RO -> ModName
roMod   :: !ModName
  , RO -> NamingEnv
roNames :: NamingEnv
  , RO -> NameDisp
roDisp  :: !NameDisp
  }

data RW = RW
  { RW -> RenamerWarnings
rwWarnings      :: !RenamerWarnings
  , RW -> Seq RenamerError
rwErrors        :: !(Seq.Seq RenamerError)
  , RW -> Supply
rwSupply        :: !Supply
  , RW -> Map Name Int
rwNameUseCount  :: !(Map Name Int)
    -- ^ How many times did we refer to each name.
    -- Used to generate warnings for unused definitions.
  }



newtype RenameM a = RenameM
  { RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM :: ReaderT RO (StateT RW Lift) a }

instance S.Semigroup a => S.Semigroup (RenameM a) where
  {-# INLINE (<>) #-}
  RenameM a
a <> :: RenameM a -> RenameM a -> RenameM a
<> RenameM a
b =
    do a
x <- RenameM a
a
       a
y <- RenameM a
b
       a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
S.<> a
y)

instance (S.Semigroup a, Monoid a) => Monoid (RenameM a) where
  {-# INLINE mempty #-}
  mempty :: RenameM a
mempty = a -> RenameM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty

  {-# INLINE mappend #-}
  mappend :: RenameM a -> RenameM a -> RenameM a
mappend = RenameM a -> RenameM a -> RenameM a
forall a. Semigroup a => a -> a -> a
(S.<>)

instance Functor RenameM where
  {-# INLINE fmap #-}
  fmap :: (a -> b) -> RenameM a -> RenameM b
fmap a -> b
f RenameM a
m      = ReaderT RO (StateT RW Lift) b -> RenameM b
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM ((a -> b)
-> ReaderT RO (StateT RW Lift) a -> ReaderT RO (StateT RW Lift) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (RenameM a -> ReaderT RO (StateT RW Lift) a
forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM RenameM a
m))

instance Applicative RenameM where
  {-# INLINE pure #-}
  pure :: a -> RenameM a
pure a
x        = ReaderT RO (StateT RW Lift) a -> RenameM a
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (a -> ReaderT RO (StateT RW Lift) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)

  {-# INLINE (<*>) #-}
  RenameM (a -> b)
l <*> :: RenameM (a -> b) -> RenameM a -> RenameM b
<*> RenameM a
r       = ReaderT RO (StateT RW Lift) b -> RenameM b
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (RenameM (a -> b) -> ReaderT RO (StateT RW Lift) (a -> b)
forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM RenameM (a -> b)
l ReaderT RO (StateT RW Lift) (a -> b)
-> ReaderT RO (StateT RW Lift) a -> ReaderT RO (StateT RW Lift) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RenameM a -> ReaderT RO (StateT RW Lift) a
forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM RenameM a
r)

instance Monad RenameM where
  {-# INLINE return #-}
  return :: a -> RenameM a
return a
x      = ReaderT RO (StateT RW Lift) a -> RenameM a
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (a -> ReaderT RO (StateT RW Lift) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x)

  {-# INLINE (>>=) #-}
  RenameM a
m >>= :: RenameM a -> (a -> RenameM b) -> RenameM b
>>= a -> RenameM b
k       = ReaderT RO (StateT RW Lift) b -> RenameM b
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (RenameM a -> ReaderT RO (StateT RW Lift) a
forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM RenameM a
m ReaderT RO (StateT RW Lift) a
-> (a -> ReaderT RO (StateT RW Lift) b)
-> ReaderT RO (StateT RW Lift) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RenameM b -> ReaderT RO (StateT RW Lift) b
forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM (RenameM b -> ReaderT RO (StateT RW Lift) b)
-> (a -> RenameM b) -> a -> ReaderT RO (StateT RW Lift) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RenameM b
k)

instance FreshM RenameM where
  liftSupply :: (Supply -> (a, Supply)) -> RenameM a
liftSupply Supply -> (a, Supply)
f = ReaderT RO (StateT RW Lift) a -> RenameM a
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (ReaderT RO (StateT RW Lift) a -> RenameM a)
-> ReaderT RO (StateT RW Lift) a -> RenameM a
forall a b. (a -> b) -> a -> b
$ (RW -> (a, RW)) -> ReaderT RO (StateT RW Lift) a
forall (m :: * -> *) s a. StateM m s => (s -> (a, s)) -> m a
sets ((RW -> (a, RW)) -> ReaderT RO (StateT RW Lift) a)
-> (RW -> (a, RW)) -> ReaderT RO (StateT RW Lift) a
forall a b. (a -> b) -> a -> b
$ \ RW { Map Name Int
Seq RenamerError
Supply
RenamerWarnings
rwNameUseCount :: Map Name Int
rwSupply :: Supply
rwErrors :: Seq RenamerError
rwWarnings :: RenamerWarnings
rwNameUseCount :: RW -> Map Name Int
rwSupply :: RW -> Supply
rwErrors :: RW -> Seq RenamerError
rwWarnings :: RW -> RenamerWarnings
.. } ->
    let (a
a,Supply
s') = Supply -> (a, Supply)
f Supply
rwSupply
        rw' :: RW
rw'    = RW :: RenamerWarnings -> Seq RenamerError -> Supply -> Map Name Int -> RW
RW { rwSupply :: Supply
rwSupply = Supply
s', Map Name Int
Seq RenamerError
RenamerWarnings
rwNameUseCount :: Map Name Int
rwErrors :: Seq RenamerError
rwWarnings :: RenamerWarnings
rwNameUseCount :: Map Name Int
rwErrors :: Seq RenamerError
rwWarnings :: RenamerWarnings
.. }
     in a
a a -> (a, RW) -> (a, RW)
`seq` RW
rw' RW -> (a, RW) -> (a, RW)
`seq` (a
a, RW
rw')

runRenamer :: Supply -> ModName -> NamingEnv -> RenameM a
           -> (Either [RenamerError] (a,Supply),[RenamerWarning])
runRenamer :: Supply
-> ModName
-> NamingEnv
-> RenameM a
-> (Either [RenamerError] (a, Supply), [RenamerWarning])
runRenamer Supply
s ModName
ns NamingEnv
env RenameM a
m = (Either [RenamerError] (a, Supply)
res, RenamerWarnings -> [RenamerWarning]
listRenamerWarnings RenamerWarnings
warns)
  where
  warns :: RenamerWarnings
warns = (RenamerWarning -> RenamerWarnings -> RenamerWarnings)
-> RenamerWarnings -> [RenamerWarning] -> RenamerWarnings
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RenamerWarning -> RenamerWarnings -> RenamerWarnings
addRenamerWarning (RW -> RenamerWarnings
rwWarnings RW
rw)
                                  (ModName -> NamingEnv -> RO -> RW -> [RenamerWarning]
warnUnused ModName
ns NamingEnv
env RO
ro RW
rw)

  (a
a,RW
rw) = ReaderT RO (StateT RW Lift) a -> RO -> RW -> (a, RW)
forall (m :: * -> *) a r. RunM m a r => m a -> r
runM (RenameM a -> ReaderT RO (StateT RW Lift) a
forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM RenameM a
m) RO
ro
                              RW :: RenamerWarnings -> Seq RenamerError -> Supply -> Map Name Int -> RW
RW { rwErrors :: Seq RenamerError
rwErrors   = Seq RenamerError
forall a. Seq a
Seq.empty
                                 , rwWarnings :: RenamerWarnings
rwWarnings = RenamerWarnings
noRenamerWarnings
                                 , rwSupply :: Supply
rwSupply   = Supply
s
                                 , rwNameUseCount :: Map Name Int
rwNameUseCount = Map Name Int
forall k a. Map k a
Map.empty
                                 }

  ro :: RO
ro = RO :: Range -> ModName -> NamingEnv -> NameDisp -> RO
RO { roLoc :: Range
roLoc = Range
emptyRange
          , roNames :: NamingEnv
roNames = NamingEnv
env
          , roMod :: ModName
roMod = ModName
ns
          , roDisp :: NameDisp
roDisp = ModName -> NameDisp
neverQualifyMod ModName
ns NameDisp -> NameDisp -> NameDisp
forall a. Monoid a => a -> a -> a
`mappend` NamingEnv -> NameDisp
toNameDisp NamingEnv
env
          }

  res :: Either [RenamerError] (a, Supply)
res | Seq RenamerError -> Bool
forall a. Seq a -> Bool
Seq.null (RW -> Seq RenamerError
rwErrors RW
rw) = (a, Supply) -> Either [RenamerError] (a, Supply)
forall a b. b -> Either a b
Right (a
a,RW -> Supply
rwSupply RW
rw)
      | Bool
otherwise              = [RenamerError] -> Either [RenamerError] (a, Supply)
forall a b. a -> Either a b
Left (Seq RenamerError -> [RenamerError]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (RW -> Seq RenamerError
rwErrors RW
rw))

-- | Record an error.  XXX: use a better name
record :: (NameDisp -> RenamerError) -> RenameM ()
record :: (NameDisp -> RenamerError) -> RenameM ()
record NameDisp -> RenamerError
f = ReaderT RO (StateT RW Lift) () -> RenameM ()
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (ReaderT RO (StateT RW Lift) () -> RenameM ())
-> ReaderT RO (StateT RW Lift) () -> RenameM ()
forall a b. (a -> b) -> a -> b
$
  do RO { ModName
NameDisp
Range
NamingEnv
roDisp :: NameDisp
roNames :: NamingEnv
roMod :: ModName
roLoc :: Range
roDisp :: RO -> NameDisp
roNames :: RO -> NamingEnv
roMod :: RO -> ModName
roLoc :: RO -> Range
.. } <- ReaderT RO (StateT RW Lift) RO
forall (m :: * -> *) i. ReaderM m i => m i
ask
     RW { Map Name Int
Seq RenamerError
Supply
RenamerWarnings
rwNameUseCount :: Map Name Int
rwSupply :: Supply
rwErrors :: Seq RenamerError
rwWarnings :: RenamerWarnings
rwNameUseCount :: RW -> Map Name Int
rwSupply :: RW -> Supply
rwErrors :: RW -> Seq RenamerError
rwWarnings :: RW -> RenamerWarnings
.. } <- ReaderT RO (StateT RW Lift) RW
forall (m :: * -> *) i. StateM m i => m i
get
     RW -> ReaderT RO (StateT RW Lift) ()
forall (m :: * -> *) i. StateM m i => i -> m ()
set RW :: RenamerWarnings -> Seq RenamerError -> Supply -> Map Name Int -> RW
RW { rwErrors :: Seq RenamerError
rwErrors = Seq RenamerError
rwErrors Seq RenamerError -> RenamerError -> Seq RenamerError
forall a. Seq a -> a -> Seq a
Seq.|> NameDisp -> RenamerError
f NameDisp
roDisp, Map Name Int
Supply
RenamerWarnings
rwNameUseCount :: Map Name Int
rwSupply :: Supply
rwWarnings :: RenamerWarnings
rwNameUseCount :: Map Name Int
rwSupply :: Supply
rwWarnings :: RenamerWarnings
.. }

-- | Get the source range for wahtever we are currently renaming.
curLoc :: RenameM Range
curLoc :: RenameM Range
curLoc  = ReaderT RO (StateT RW Lift) Range -> RenameM Range
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (RO -> Range
roLoc (RO -> Range)
-> ReaderT RO (StateT RW Lift) RO
-> ReaderT RO (StateT RW Lift) Range
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ReaderT RO (StateT RW Lift) RO
forall (m :: * -> *) i. ReaderM m i => m i
ask)

-- | Annotate something with the current range.
located :: a -> RenameM (Located a)
located :: a -> RenameM (Located a)
located a
thing =
  do Range
srcRange <- RenameM Range
curLoc
     Located a -> RenameM (Located a)
forall (m :: * -> *) a. Monad m => a -> m a
return Located :: forall a. Range -> a -> Located a
Located { a
Range
srcRange :: Range
thing :: a
thing :: a
srcRange :: Range
.. }

-- | Do the given computation using the source code range from `loc` if any.
withLoc :: HasLoc loc => loc -> RenameM a -> RenameM a
withLoc :: loc -> RenameM a -> RenameM a
withLoc loc
loc RenameM a
m = ReaderT RO (StateT RW Lift) a -> RenameM a
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (ReaderT RO (StateT RW Lift) a -> RenameM a)
-> ReaderT RO (StateT RW Lift) a -> RenameM a
forall a b. (a -> b) -> a -> b
$ case loc -> Maybe Range
forall t. HasLoc t => t -> Maybe Range
getLoc loc
loc of

  Just Range
range -> do
    RO
ro <- ReaderT RO (StateT RW Lift) RO
forall (m :: * -> *) i. ReaderM m i => m i
ask
    RO
-> ReaderT RO (StateT RW Lift) a -> ReaderT RO (StateT RW Lift) a
forall (m :: * -> *) i a. RunReaderM m i => i -> m a -> m a
local RO
ro { roLoc :: Range
roLoc = Range
range } (RenameM a -> ReaderT RO (StateT RW Lift) a
forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM RenameM a
m)

  Maybe Range
Nothing -> RenameM a -> ReaderT RO (StateT RW Lift) a
forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM RenameM a
m

-- | Retrieve the name of the current module.
getNS :: RenameM ModName
getNS :: RenameM ModName
getNS  = ReaderT RO (StateT RW Lift) ModName -> RenameM ModName
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (RO -> ModName
roMod (RO -> ModName)
-> ReaderT RO (StateT RW Lift) RO
-> ReaderT RO (StateT RW Lift) ModName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ReaderT RO (StateT RW Lift) RO
forall (m :: * -> *) i. ReaderM m i => m i
ask)

-- | Shadow the current naming environment with some more names.
shadowNames :: BindsNames env => env -> RenameM a -> RenameM a
shadowNames :: env -> RenameM a -> RenameM a
shadowNames  = EnvCheck -> env -> RenameM a -> RenameM a
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckAll

data EnvCheck = CheckAll     -- ^ Check for overlap and shadowing
              | CheckOverlap -- ^ Only check for overlap
              | CheckNone    -- ^ Don't check the environment
                deriving (EnvCheck -> EnvCheck -> Bool
(EnvCheck -> EnvCheck -> Bool)
-> (EnvCheck -> EnvCheck -> Bool) -> Eq EnvCheck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnvCheck -> EnvCheck -> Bool
$c/= :: EnvCheck -> EnvCheck -> Bool
== :: EnvCheck -> EnvCheck -> Bool
$c== :: EnvCheck -> EnvCheck -> Bool
Eq,Int -> EnvCheck -> ShowS
[EnvCheck] -> ShowS
EnvCheck -> String
(Int -> EnvCheck -> ShowS)
-> (EnvCheck -> String) -> ([EnvCheck] -> ShowS) -> Show EnvCheck
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnvCheck] -> ShowS
$cshowList :: [EnvCheck] -> ShowS
show :: EnvCheck -> String
$cshow :: EnvCheck -> String
showsPrec :: Int -> EnvCheck -> ShowS
$cshowsPrec :: Int -> EnvCheck -> ShowS
Show)

-- | Shadow the current naming environment with some more names.
shadowNames' :: BindsNames env => EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' :: EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
check env
names RenameM a
m = do
  do NamingEnv
env <- (Supply -> (NamingEnv, Supply)) -> RenameM NamingEnv
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (env -> Supply -> (NamingEnv, Supply)
forall a. BindsNames a => a -> Supply -> (NamingEnv, Supply)
namingEnv' env
names)
     ReaderT RO (StateT RW Lift) a -> RenameM a
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (ReaderT RO (StateT RW Lift) a -> RenameM a)
-> ReaderT RO (StateT RW Lift) a -> RenameM a
forall a b. (a -> b) -> a -> b
$
       do RO
ro  <- ReaderT RO (StateT RW Lift) RO
forall (m :: * -> *) i. ReaderM m i => m i
ask
          NamingEnv
env' <- (RW -> (NamingEnv, RW)) -> ReaderT RO (StateT RW Lift) NamingEnv
forall (m :: * -> *) s a. StateM m s => (s -> (a, s)) -> m a
sets (NameDisp
-> EnvCheck -> NamingEnv -> NamingEnv -> RW -> (NamingEnv, RW)
checkEnv (RO -> NameDisp
roDisp RO
ro) EnvCheck
check NamingEnv
env (RO -> NamingEnv
roNames RO
ro))
          let ro' :: RO
ro' = RO
ro { roNames :: NamingEnv
roNames = NamingEnv
env' NamingEnv -> NamingEnv -> NamingEnv
`shadowing` RO -> NamingEnv
roNames RO
ro }
          RO
-> ReaderT RO (StateT RW Lift) a -> ReaderT RO (StateT RW Lift) a
forall (m :: * -> *) i a. RunReaderM m i => i -> m a -> m a
local RO
ro' (RenameM a -> ReaderT RO (StateT RW Lift) a
forall a. RenameM a -> ReaderT RO (StateT RW Lift) a
unRenameM RenameM a
m)

shadowNamesNS :: BindsNames (InModule env) => env -> RenameM a -> RenameM a
shadowNamesNS :: env -> RenameM a -> RenameM a
shadowNamesNS env
names RenameM a
m =
  do ModName
ns <- RenameM ModName
getNS
     InModule env -> RenameM a -> RenameM a
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames (ModName -> env -> InModule env
forall a. ModName -> a -> InModule a
InModule ModName
ns env
names) RenameM a
m


-- | Generate warnings when the left environment shadows things defined in
-- the right.  Additionally, generate errors when two names overlap in the
-- left environment.
checkEnv :: NameDisp -> EnvCheck -> NamingEnv -> NamingEnv -> RW -> (NamingEnv,RW)
checkEnv :: NameDisp
-> EnvCheck -> NamingEnv -> NamingEnv -> RW -> (NamingEnv, RW)
checkEnv NameDisp
disp EnvCheck
check NamingEnv
l NamingEnv
r RW
rw
  | EnvCheck
check EnvCheck -> EnvCheck -> Bool
forall a. Eq a => a -> a -> Bool
== EnvCheck
CheckNone = (NamingEnv
l',RW
rw)
  | Bool
otherwise          = (NamingEnv
l',RW
rw'')

  where

  l' :: NamingEnv
l' = NamingEnv
l { neExprs :: Map PName [Name]
neExprs = Map PName [Name]
es, neTypes :: Map PName [Name]
neTypes = Map PName [Name]
ts }

  (RW
rw',Map PName [Name]
es)  = (RW -> PName -> [Name] -> (RW, [Name]))
-> RW -> Map PName [Name] -> (RW, Map PName [Name])
forall a k b c.
(a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
Map.mapAccumWithKey ((NamingEnv -> Map PName [Name])
-> RW -> PName -> [Name] -> (RW, [Name])
forall k.
Ord k =>
(NamingEnv -> Map k [Name]) -> RW -> k -> [Name] -> (RW, [Name])
step NamingEnv -> Map PName [Name]
neExprs) RW
rw  (NamingEnv -> Map PName [Name]
neExprs NamingEnv
l)
  (RW
rw'',Map PName [Name]
ts) = (RW -> PName -> [Name] -> (RW, [Name]))
-> RW -> Map PName [Name] -> (RW, Map PName [Name])
forall a k b c.
(a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
Map.mapAccumWithKey ((NamingEnv -> Map PName [Name])
-> RW -> PName -> [Name] -> (RW, [Name])
forall k.
Ord k =>
(NamingEnv -> Map k [Name]) -> RW -> k -> [Name] -> (RW, [Name])
step NamingEnv -> Map PName [Name]
neTypes) RW
rw' (NamingEnv -> Map PName [Name]
neTypes NamingEnv
l)

  step :: (NamingEnv -> Map k [Name]) -> RW -> k -> [Name] -> (RW, [Name])
step NamingEnv -> Map k [Name]
prj RW
acc k
k [Name]
ns = (RW
acc', [[Name] -> Name
forall a. [a] -> a
head [Name]
ns])
    where
    acc' :: RW
acc' = RW
acc
      { rwWarnings :: RenamerWarnings
rwWarnings =
          if EnvCheck
check EnvCheck -> EnvCheck -> Bool
forall a. Eq a => a -> a -> Bool
== EnvCheck
CheckAll
             then case k -> Map k [Name] -> Maybe [Name]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k (NamingEnv -> Map k [Name]
prj NamingEnv
r) of
                    Maybe [Name]
Nothing -> RW -> RenamerWarnings
rwWarnings RW
acc
                    Just [Name]
os -> RenamerWarning -> RenamerWarnings -> RenamerWarnings
addRenamerWarning 
                                    (Name -> [Name] -> NameDisp -> RenamerWarning
SymbolShadowed ([Name] -> Name
forall a. [a] -> a
head [Name]
ns) [Name]
os NameDisp
disp)
                                    (RW -> RenamerWarnings
rwWarnings RW
acc)

             else RW -> RenamerWarnings
rwWarnings RW
acc
      , rwErrors :: Seq RenamerError
rwErrors   = RW -> Seq RenamerError
rwErrors RW
acc Seq RenamerError -> Seq RenamerError -> Seq RenamerError
forall a. Seq a -> Seq a -> Seq a
Seq.>< NameDisp -> [Name] -> Seq RenamerError
containsOverlap NameDisp
disp [Name]
ns
      }

-- | Check the RHS of a single name rewrite for conflicting sources.
containsOverlap :: NameDisp -> [Name] -> Seq.Seq RenamerError
containsOverlap :: NameDisp -> [Name] -> Seq RenamerError
containsOverlap NameDisp
_    [Name
_] = Seq RenamerError
forall a. Seq a
Seq.empty
containsOverlap NameDisp
_    []  = String -> [String] -> Seq RenamerError
forall a. HasCallStack => String -> [String] -> a
panic String
"Renamer" [String
"Invalid naming environment"]
containsOverlap NameDisp
disp [Name]
ns  = RenamerError -> Seq RenamerError
forall a. a -> Seq a
Seq.singleton ([Name] -> NameDisp -> RenamerError
OverlappingSyms [Name]
ns NameDisp
disp)

-- | Throw errors for any names that overlap in a rewrite environment.
checkNamingEnv :: NamingEnv -> ([RenamerError],[RenamerWarning])
checkNamingEnv :: NamingEnv -> ([RenamerError], [RenamerWarning])
checkNamingEnv NamingEnv
env = (Seq RenamerError -> [RenamerError]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq RenamerError
out, [])
  where
  out :: Seq RenamerError
out    = ([Name] -> Seq RenamerError -> Seq RenamerError)
-> Seq RenamerError -> Map PName [Name] -> Seq RenamerError
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr [Name] -> Seq RenamerError -> Seq RenamerError
check Seq RenamerError
outTys (NamingEnv -> Map PName [Name]
neExprs NamingEnv
env)
  outTys :: Seq RenamerError
outTys = ([Name] -> Seq RenamerError -> Seq RenamerError)
-> Seq RenamerError -> Map PName [Name] -> Seq RenamerError
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr [Name] -> Seq RenamerError -> Seq RenamerError
check Seq RenamerError
forall a. Monoid a => a
mempty (NamingEnv -> Map PName [Name]
neTypes NamingEnv
env)

  disp :: NameDisp
disp   = NamingEnv -> NameDisp
toNameDisp NamingEnv
env

  check :: [Name] -> Seq RenamerError -> Seq RenamerError
check [Name]
ns Seq RenamerError
acc = NameDisp -> [Name] -> Seq RenamerError
containsOverlap NameDisp
disp [Name]
ns Seq RenamerError -> Seq RenamerError -> Seq RenamerError
forall a. Seq a -> Seq a -> Seq a
Seq.>< Seq RenamerError
acc

recordUse :: Name -> RenameM ()
recordUse :: Name -> RenameM ()
recordUse Name
x = ReaderT RO (StateT RW Lift) () -> RenameM ()
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM (ReaderT RO (StateT RW Lift) () -> RenameM ())
-> ReaderT RO (StateT RW Lift) () -> RenameM ()
forall a b. (a -> b) -> a -> b
$ (RW -> RW) -> ReaderT RO (StateT RW Lift) ()
forall (m :: * -> *) s. StateM m s => (s -> s) -> m ()
sets_ ((RW -> RW) -> ReaderT RO (StateT RW Lift) ())
-> (RW -> RW) -> ReaderT RO (StateT RW Lift) ()
forall a b. (a -> b) -> a -> b
$ \RW
rw ->
  RW
rw { rwNameUseCount :: Map Name Int
rwNameUseCount = (Int -> Int -> Int) -> Name -> Int -> Map Name Int -> Map Name Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Name
x Int
1 (RW -> Map Name Int
rwNameUseCount RW
rw) }


warnUnused :: ModName -> NamingEnv -> RO -> RW -> [RenamerWarning]
warnUnused :: ModName -> NamingEnv -> RO -> RW -> [RenamerWarning]
warnUnused ModName
m0 NamingEnv
env RO
ro RW
rw =
  (Name -> RenamerWarning) -> [Name] -> [RenamerWarning]
forall a b. (a -> b) -> [a] -> [b]
map Name -> RenamerWarning
warn
  ([Name] -> [RenamerWarning]) -> [Name] -> [RenamerWarning]
forall a b. (a -> b) -> a -> b
$ Map Name Int -> [Name]
forall k a. Map k a -> [k]
Map.keys
  (Map Name Int -> [Name]) -> Map Name Int -> [Name]
forall a b. (a -> b) -> a -> b
$ (Name -> Int -> Bool) -> Map Name Int -> Map Name Int
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey Name -> Int -> Bool
forall a. (Eq a, Num a) => Name -> a -> Bool
keep
  (Map Name Int -> Map Name Int) -> Map Name Int -> Map Name Int
forall a b. (a -> b) -> a -> b
$ RW -> Map Name Int
rwNameUseCount RW
rw
  where
  warn :: Name -> RenamerWarning
warn Name
x   = Name -> NameDisp -> RenamerWarning
UnusedName Name
x (RO -> NameDisp
roDisp RO
ro)
  keep :: Name -> a -> Bool
keep Name
k a
n = a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 Bool -> Bool -> Bool
&& Name -> Bool
isLocal Name
k
  oldNames :: Set Name
oldNames = (Set Name, Set Name) -> Set Name
forall a b. (a, b) -> a
fst (NamingEnv -> (Set Name, Set Name)
visibleNames NamingEnv
env)
  isLocal :: Name -> Bool
isLocal Name
nm = case Name -> NameInfo
nameInfo Name
nm of
                 Declared ModName
m NameSource
sys -> NameSource
sys NameSource -> NameSource -> Bool
forall a. Eq a => a -> a -> Bool
== NameSource
UserName Bool -> Bool -> Bool
&&
                                   ModName
m ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
== ModName
m0 Bool -> Bool -> Bool
&& Name
nm Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Name
oldNames
                 NameInfo
Parameter  -> Bool
True

-- Renaming --------------------------------------------------------------------

class Rename f where
  rename :: f PName -> RenameM (f Name)

renameModule :: Module PName -> RenameM (NamingEnv,Module Name)
renameModule :: Module PName -> RenameM (NamingEnv, Module Name)
renameModule Module PName
m =
  do NamingEnv
env    <- (Supply -> (NamingEnv, Supply)) -> RenameM NamingEnv
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Module PName -> Supply -> (NamingEnv, Supply)
forall a. BindsNames a => a -> Supply -> (NamingEnv, Supply)
namingEnv' Module PName
m)
     -- NOTE: we explicitly hide shadowing errors here, by using shadowNames'
     [TopDecl Name]
decls' <-  EnvCheck
-> NamingEnv -> RenameM [TopDecl Name] -> RenameM [TopDecl Name]
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckOverlap NamingEnv
env ((TopDecl PName -> RenameM (TopDecl Name))
-> [TopDecl PName] -> RenameM [TopDecl Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TopDecl PName -> RenameM (TopDecl Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (Module PName -> [TopDecl PName]
forall name. Module name -> [TopDecl name]
mDecls Module PName
m))
     let m1 :: Module Name
m1 = Module PName
m { mDecls :: [TopDecl Name]
mDecls = [TopDecl Name]
decls' }
         exports :: ExportSpec Name
exports = Module Name -> ExportSpec Name
forall name. Ord name => Module name -> ExportSpec name
modExports Module Name
m1
     (Name -> RenameM ()) -> Set Name -> RenameM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name -> RenameM ()
recordUse (ExportSpec Name -> Set Name
forall name. ExportSpec name -> Set name
eTypes ExportSpec Name
exports)
     (NamingEnv, Module Name) -> RenameM (NamingEnv, Module Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
env,Module Name
m1)

instance Rename TopDecl where
  rename :: TopDecl PName -> RenameM (TopDecl Name)
rename TopDecl PName
td     = case TopDecl PName
td of
    Decl TopLevel (Decl PName)
d      -> TopLevel (Decl Name) -> TopDecl Name
forall name. TopLevel (Decl name) -> TopDecl name
Decl      (TopLevel (Decl Name) -> TopDecl Name)
-> RenameM (TopLevel (Decl Name)) -> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Decl PName -> RenameM (Decl Name))
-> TopLevel (Decl PName) -> RenameM (TopLevel (Decl Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Decl PName -> RenameM (Decl Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TopLevel (Decl PName)
d
    DPrimType TopLevel (PrimType PName)
d -> TopLevel (PrimType Name) -> TopDecl Name
forall name. TopLevel (PrimType name) -> TopDecl name
DPrimType (TopLevel (PrimType Name) -> TopDecl Name)
-> RenameM (TopLevel (PrimType Name)) -> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PrimType PName -> RenameM (PrimType Name))
-> TopLevel (PrimType PName) -> RenameM (TopLevel (PrimType Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse PrimType PName -> RenameM (PrimType Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TopLevel (PrimType PName)
d
    TDNewtype TopLevel (Newtype PName)
n -> TopLevel (Newtype Name) -> TopDecl Name
forall name. TopLevel (Newtype name) -> TopDecl name
TDNewtype (TopLevel (Newtype Name) -> TopDecl Name)
-> RenameM (TopLevel (Newtype Name)) -> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Newtype PName -> RenameM (Newtype Name))
-> TopLevel (Newtype PName) -> RenameM (TopLevel (Newtype Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Newtype PName -> RenameM (Newtype Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TopLevel (Newtype PName)
n
    Include Located String
n   -> TopDecl Name -> RenameM (TopDecl Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located String -> TopDecl Name
forall name. Located String -> TopDecl name
Include Located String
n)
    DParameterFun ParameterFun PName
f  -> ParameterFun Name -> TopDecl Name
forall name. ParameterFun name -> TopDecl name
DParameterFun  (ParameterFun Name -> TopDecl Name)
-> RenameM (ParameterFun Name) -> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParameterFun PName -> RenameM (ParameterFun Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename ParameterFun PName
f
    DParameterType ParameterType PName
f -> ParameterType Name -> TopDecl Name
forall name. ParameterType name -> TopDecl name
DParameterType (ParameterType Name -> TopDecl Name)
-> RenameM (ParameterType Name) -> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParameterType PName -> RenameM (ParameterType Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename ParameterType PName
f

    DParameterConstraint [Located (Prop PName)]
d -> [Located (Prop Name)] -> TopDecl Name
forall name. [Located (Prop name)] -> TopDecl name
DParameterConstraint ([Located (Prop Name)] -> TopDecl Name)
-> RenameM [Located (Prop Name)] -> RenameM (TopDecl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Located (Prop PName) -> RenameM (Located (Prop Name)))
-> [Located (Prop PName)] -> RenameM [Located (Prop Name)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Located (Prop PName) -> RenameM (Located (Prop Name))
forall (f :: * -> *).
Rename f =>
Located (f PName) -> RenameM (Located (f Name))
renameLocated [Located (Prop PName)]
d

renameLocated :: Rename f => Located (f PName) -> RenameM (Located (f Name))
renameLocated :: Located (f PName) -> RenameM (Located (f Name))
renameLocated Located (f PName)
x =
  do f Name
y <- f PName -> RenameM (f Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (Located (f PName) -> f PName
forall a. Located a -> a
thing Located (f PName)
x)
     Located (f Name) -> RenameM (Located (f Name))
forall (m :: * -> *) a. Monad m => a -> m a
return Located (f PName)
x { thing :: f Name
thing = f Name
y }

instance Rename PrimType where
  rename :: PrimType PName -> RenameM (PrimType Name)
rename PrimType PName
pt =
    do Located Name
x <- (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated PName -> RenameM Name
renameType (PrimType PName -> Located PName
forall name. PrimType name -> Located name
primTName PrimType PName
pt)
       let ([TParam PName]
as,[Prop PName]
ps) = PrimType PName -> ([TParam PName], [Prop PName])
forall name. PrimType name -> ([TParam name], [Prop name])
primTCts PrimType PName
pt
       (NamingEnv
_,([TParam Name], [Prop Name])
cts) <- [TParam PName]
-> [Prop PName]
-> ([TParam Name]
    -> [Prop Name] -> RenameM ([TParam Name], [Prop Name]))
-> RenameM (NamingEnv, ([TParam Name], [Prop Name]))
forall a.
[TParam PName]
-> [Prop PName]
-> ([TParam Name] -> [Prop Name] -> RenameM a)
-> RenameM (NamingEnv, a)
renameQual [TParam PName]
as [Prop PName]
ps (([TParam Name]
  -> [Prop Name] -> RenameM ([TParam Name], [Prop Name]))
 -> RenameM (NamingEnv, ([TParam Name], [Prop Name])))
-> ([TParam Name]
    -> [Prop Name] -> RenameM ([TParam Name], [Prop Name]))
-> RenameM (NamingEnv, ([TParam Name], [Prop Name]))
forall a b. (a -> b) -> a -> b
$ \[TParam Name]
as' [Prop Name]
ps' -> ([TParam Name], [Prop Name])
-> RenameM ([TParam Name], [Prop Name])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TParam Name]
as',[Prop Name]
ps')
       PrimType Name -> RenameM (PrimType Name)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimType PName
pt { primTCts :: ([TParam Name], [Prop Name])
primTCts = ([TParam Name], [Prop Name])
cts, primTName :: Located Name
primTName = Located Name
x }

instance Rename ParameterType where
  rename :: ParameterType PName -> RenameM (ParameterType Name)
rename ParameterType PName
a =
    do Located Name
n' <- (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated PName -> RenameM Name
renameType (ParameterType PName -> Located PName
forall name. ParameterType name -> Located name
ptName ParameterType PName
a)
       ParameterType Name -> RenameM (ParameterType Name)
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterType PName
a { ptName :: Located Name
ptName = Located Name
n' }

instance Rename ParameterFun where
  rename :: ParameterFun PName -> RenameM (ParameterFun Name)
rename ParameterFun PName
a =
    do Located Name
n'   <- (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated PName -> RenameM Name
renameVar (ParameterFun PName -> Located PName
forall name. ParameterFun name -> Located name
pfName ParameterFun PName
a)
       (NamingEnv, Schema Name)
sig' <- Schema PName -> RenameM (NamingEnv, Schema Name)
renameSchema (ParameterFun PName -> Schema PName
forall name. ParameterFun name -> Schema name
pfSchema ParameterFun PName
a)
       ParameterFun Name -> RenameM (ParameterFun Name)
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterFun PName
a { pfName :: Located Name
pfName = Located Name
n', pfSchema :: Schema Name
pfSchema = (NamingEnv, Schema Name) -> Schema Name
forall a b. (a, b) -> b
snd (NamingEnv, Schema Name)
sig' }

rnLocated :: (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated :: (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated a -> RenameM b
f Located a
loc = Located a -> RenameM (Located b) -> RenameM (Located b)
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Located a
loc (RenameM (Located b) -> RenameM (Located b))
-> RenameM (Located b) -> RenameM (Located b)
forall a b. (a -> b) -> a -> b
$
  do b
a' <- a -> RenameM b
f (Located a -> a
forall a. Located a -> a
thing Located a
loc)
     Located b -> RenameM (Located b)
forall (m :: * -> *) a. Monad m => a -> m a
return Located a
loc { thing :: b
thing = b
a' }

instance Rename Decl where
  rename :: Decl PName -> RenameM (Decl Name)
rename Decl PName
d      = case Decl PName
d of
    DSignature [Located PName]
ns Schema PName
sig -> [Located Name] -> Schema Name -> Decl Name
forall name. [Located name] -> Schema name -> Decl name
DSignature    ([Located Name] -> Schema Name -> Decl Name)
-> RenameM [Located Name] -> RenameM (Schema Name -> Decl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Located PName -> RenameM (Located Name))
-> [Located PName] -> RenameM [Located Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated PName -> RenameM Name
renameVar) [Located PName]
ns
                                       RenameM (Schema Name -> Decl Name)
-> RenameM (Schema Name) -> RenameM (Decl Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Schema PName -> RenameM (Schema Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Schema PName
sig
    DPragma [Located PName]
ns Pragma
p      -> [Located Name] -> Pragma -> Decl Name
forall name. [Located name] -> Pragma -> Decl name
DPragma       ([Located Name] -> Pragma -> Decl Name)
-> RenameM [Located Name] -> RenameM (Pragma -> Decl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Located PName -> RenameM (Located Name))
-> [Located PName] -> RenameM [Located Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated PName -> RenameM Name
renameVar) [Located PName]
ns
                                       RenameM (Pragma -> Decl Name)
-> RenameM Pragma -> RenameM (Decl Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pragma -> RenameM Pragma
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pragma
p
    DBind Bind PName
b           -> Bind Name -> Decl Name
forall name. Bind name -> Decl name
DBind         (Bind Name -> Decl Name)
-> RenameM (Bind Name) -> RenameM (Decl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bind PName -> RenameM (Bind Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Bind PName
b

    -- XXX we probably shouldn't see these at this point...
    DPatBind Pattern PName
pat Expr PName
e    -> do (NamingEnv
pe,Pattern Name
pat') <- Pattern PName -> RenameM (NamingEnv, Pattern Name)
renamePat Pattern PName
pat
                            NamingEnv -> RenameM (Decl Name) -> RenameM (Decl Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
pe (Pattern Name -> Expr Name -> Decl Name
forall name. Pattern name -> Expr name -> Decl name
DPatBind Pattern Name
pat' (Expr Name -> Decl Name)
-> RenameM (Expr Name) -> RenameM (Decl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e)

    DType TySyn PName
syn         -> TySyn Name -> Decl Name
forall name. TySyn name -> Decl name
DType         (TySyn Name -> Decl Name)
-> RenameM (TySyn Name) -> RenameM (Decl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TySyn PName -> RenameM (TySyn Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename TySyn PName
syn
    DProp PropSyn PName
syn         -> PropSyn Name -> Decl Name
forall name. PropSyn name -> Decl name
DProp         (PropSyn Name -> Decl Name)
-> RenameM (PropSyn Name) -> RenameM (Decl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PropSyn PName -> RenameM (PropSyn Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename PropSyn PName
syn
    DLocated Decl PName
d' Range
r     -> Range -> RenameM (Decl Name) -> RenameM (Decl Name)
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
r
                       (RenameM (Decl Name) -> RenameM (Decl Name))
-> RenameM (Decl Name) -> RenameM (Decl Name)
forall a b. (a -> b) -> a -> b
$ Decl Name -> Range -> Decl Name
forall name. Decl name -> Range -> Decl name
DLocated      (Decl Name -> Range -> Decl Name)
-> RenameM (Decl Name) -> RenameM (Range -> Decl Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decl PName -> RenameM (Decl Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Decl PName
d'  RenameM (Range -> Decl Name)
-> RenameM Range -> RenameM (Decl Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range -> RenameM Range
forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
r
    DFixity{}         -> String -> [String] -> RenameM (Decl Name)
forall a. HasCallStack => String -> [String] -> a
panic String
"Renamer" [String
"Unexpected fixity declaration"
                                         , Decl PName -> String
forall a. Show a => a -> String
show Decl PName
d]

instance Rename Newtype where
  rename :: Newtype PName -> RenameM (Newtype Name)
rename Newtype PName
n      = do
    Located Name
name' <- (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated PName -> RenameM Name
renameType (Newtype PName -> Located PName
forall name. Newtype name -> Located name
nName Newtype PName
n)
    [TParam PName] -> RenameM (Newtype Name) -> RenameM (Newtype Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames (Newtype PName -> [TParam PName]
forall name. Newtype name -> [TParam name]
nParams Newtype PName
n) (RenameM (Newtype Name) -> RenameM (Newtype Name))
-> RenameM (Newtype Name) -> RenameM (Newtype Name)
forall a b. (a -> b) -> a -> b
$
      do [TParam Name]
ps'   <- (TParam PName -> RenameM (TParam Name))
-> [TParam PName] -> RenameM [TParam Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TParam PName -> RenameM (TParam Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (Newtype PName -> [TParam PName]
forall name. Newtype name -> [TParam name]
nParams Newtype PName
n)
         [Named (Type Name)]
body' <- (Named (Type PName) -> RenameM (Named (Type Name)))
-> [Named (Type PName)] -> RenameM [Named (Type Name)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Type PName -> RenameM (Type Name))
-> Named (Type PName) -> RenameM (Named (Type Name))
forall a b. (a -> RenameM b) -> Named a -> RenameM (Named b)
rnNamed Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) (Newtype PName -> [Named (Type PName)]
forall name. Newtype name -> [Named (Type name)]
nBody Newtype PName
n)
         Newtype Name -> RenameM (Newtype Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Newtype :: forall name.
Located name
-> [TParam name] -> [Named (Type name)] -> Newtype name
Newtype { nName :: Located Name
nName   = Located Name
name'
                        , nParams :: [TParam Name]
nParams = [TParam Name]
ps'
                        , nBody :: [Named (Type Name)]
nBody   = [Named (Type Name)]
body' }

renameVar :: PName -> RenameM Name
renameVar :: PName -> RenameM Name
renameVar PName
qn = do
  RO
ro <- ReaderT RO (StateT RW Lift) RO -> RenameM RO
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM ReaderT RO (StateT RW Lift) RO
forall (m :: * -> *) i. ReaderM m i => m i
ask
  case PName -> Map PName [Name] -> Maybe [Name]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PName
qn (NamingEnv -> Map PName [Name]
neExprs (RO -> NamingEnv
roNames RO
ro)) of
    Just [Name
n]  -> Name -> RenameM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n
    Just []   -> String -> [String] -> RenameM Name
forall a. HasCallStack => String -> [String] -> a
panic String
"Renamer" [String
"Invalid expression renaming environment"]
    Just [Name]
syms ->
      do Located PName
n <- PName -> RenameM (Located PName)
forall a. a -> RenameM (Located a)
located PName
qn
         (NameDisp -> RenamerError) -> RenameM ()
record (Located PName -> [Name] -> NameDisp -> RenamerError
MultipleSyms Located PName
n [Name]
syms)
         Name -> RenameM Name
forall (m :: * -> *) a. Monad m => a -> m a
return ([Name] -> Name
forall a. [a] -> a
head [Name]
syms)

    -- This is an unbound value. Record an error and invent a bogus real name
    -- for it.
    Maybe [Name]
Nothing ->
      do Located PName
n <- PName -> RenameM (Located PName)
forall a. a -> RenameM (Located a)
located PName
qn

         case PName -> Map PName [Name] -> Maybe [Name]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PName
qn (NamingEnv -> Map PName [Name]
neTypes (RO -> NamingEnv
roNames RO
ro)) of
           -- types existed with the name of the value expected
           Just [Name]
_ -> (NameDisp -> RenamerError) -> RenameM ()
record (Located PName -> NameDisp -> RenamerError
ExpectedValue Located PName
n)

           -- the value is just missing
           Maybe [Name]
Nothing -> (NameDisp -> RenamerError) -> RenameM ()
record (Located PName -> NameDisp -> RenamerError
UnboundExpr Located PName
n)

         PName -> RenameM Name
mkFakeName PName
qn

-- | Produce a name if one exists. Note that this includes situations where
-- overlap exists, as it's just a query about anything being in scope. In the
-- event that overlap does exist, an error will be recorded.
typeExists :: PName -> RenameM (Maybe Name)
typeExists :: PName -> RenameM (Maybe Name)
typeExists PName
pn =
  do RO
ro <- ReaderT RO (StateT RW Lift) RO -> RenameM RO
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM ReaderT RO (StateT RW Lift) RO
forall (m :: * -> *) i. ReaderM m i => m i
ask
     case PName -> Map PName [Name] -> Maybe [Name]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PName
pn (NamingEnv -> Map PName [Name]
neTypes (RO -> NamingEnv
roNames RO
ro)) of
       Just [Name
n]  -> Name -> RenameM ()
recordUse Name
n RenameM () -> RenameM (Maybe Name) -> RenameM (Maybe Name)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Name -> RenameM (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n)
       Just []   -> String -> [String] -> RenameM (Maybe Name)
forall a. HasCallStack => String -> [String] -> a
panic String
"Renamer" [String
"Invalid type renaming environment"]
       Just [Name]
syms -> do Located PName
n <- PName -> RenameM (Located PName)
forall a. a -> RenameM (Located a)
located PName
pn
                       (Name -> RenameM ()) -> [Name] -> RenameM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name -> RenameM ()
recordUse [Name]
syms
                       (NameDisp -> RenamerError) -> RenameM ()
record (Located PName -> [Name] -> NameDisp -> RenamerError
MultipleSyms Located PName
n [Name]
syms)
                       Maybe Name -> RenameM (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Maybe Name
forall a. a -> Maybe a
Just ([Name] -> Name
forall a. [a] -> a
head [Name]
syms))
       Maybe [Name]
Nothing -> Maybe Name -> RenameM (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
forall a. Maybe a
Nothing

renameType :: PName -> RenameM Name
renameType :: PName -> RenameM Name
renameType PName
pn =
  do Maybe Name
mb <- PName -> RenameM (Maybe Name)
typeExists PName
pn
     case Maybe Name
mb of
       Just Name
n -> Name -> RenameM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n

       -- This is an unbound value. Record an error and invent a bogus real name
       -- for it.
       Maybe Name
Nothing ->
         do RO
ro <- ReaderT RO (StateT RW Lift) RO -> RenameM RO
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM ReaderT RO (StateT RW Lift) RO
forall (m :: * -> *) i. ReaderM m i => m i
ask
            let n :: Located PName
n = Located :: forall a. Range -> a -> Located a
Located { srcRange :: Range
srcRange = RO -> Range
roLoc RO
ro, thing :: PName
thing = PName
pn }

            case PName -> Map PName [Name] -> Maybe [Name]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PName
pn (NamingEnv -> Map PName [Name]
neExprs (RO -> NamingEnv
roNames RO
ro)) of

              -- values exist with the same name, so throw a different error
              Just [Name]
_ -> (NameDisp -> RenamerError) -> RenameM ()
record (Located PName -> NameDisp -> RenamerError
ExpectedType Located PName
n)

              -- no terms with the same name, so the type is just unbound
              Maybe [Name]
Nothing -> (NameDisp -> RenamerError) -> RenameM ()
record (Located PName -> NameDisp -> RenamerError
UnboundType Located PName
n)

            PName -> RenameM Name
mkFakeName PName
pn

-- | Assuming an error has been recorded already, construct a fake name that's
-- not expected to make it out of the renamer.
mkFakeName :: PName -> RenameM Name
mkFakeName :: PName -> RenameM Name
mkFakeName PName
pn =
  do RO
ro <- ReaderT RO (StateT RW Lift) RO -> RenameM RO
forall a. ReaderT RO (StateT RW Lift) a -> RenameM a
RenameM ReaderT RO (StateT RW Lift) RO
forall (m :: * -> *) i. ReaderM m i => m i
ask
     (Supply -> (Name, Supply)) -> RenameM Name
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Ident -> Range -> Supply -> (Name, Supply)
mkParameter (PName -> Ident
getIdent PName
pn) (RO -> Range
roLoc RO
ro))

-- | Rename a schema, assuming that none of its type variables are already in
-- scope.
instance Rename Schema where
  rename :: Schema PName -> RenameM (Schema Name)
rename Schema PName
s = (NamingEnv, Schema Name) -> Schema Name
forall a b. (a, b) -> b
snd ((NamingEnv, Schema Name) -> Schema Name)
-> RenameM (NamingEnv, Schema Name) -> RenameM (Schema Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Schema PName -> RenameM (NamingEnv, Schema Name)
renameSchema Schema PName
s

-- | Rename a schema, assuming that the type variables have already been brought
-- into scope.
renameSchema :: Schema PName -> RenameM (NamingEnv,Schema Name)
renameSchema :: Schema PName -> RenameM (NamingEnv, Schema Name)
renameSchema (Forall [TParam PName]
ps [Prop PName]
p Type PName
ty Maybe Range
loc) =
  [TParam PName]
-> [Prop PName]
-> ([TParam Name] -> [Prop Name] -> RenameM (Schema Name))
-> RenameM (NamingEnv, Schema Name)
forall a.
[TParam PName]
-> [Prop PName]
-> ([TParam Name] -> [Prop Name] -> RenameM a)
-> RenameM (NamingEnv, a)
renameQual [TParam PName]
ps [Prop PName]
p (([TParam Name] -> [Prop Name] -> RenameM (Schema Name))
 -> RenameM (NamingEnv, Schema Name))
-> ([TParam Name] -> [Prop Name] -> RenameM (Schema Name))
-> RenameM (NamingEnv, Schema Name)
forall a b. (a -> b) -> a -> b
$ \[TParam Name]
ps' [Prop Name]
p' ->
    do Type Name
ty' <- Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty
       Schema Name -> RenameM (Schema Name)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TParam Name]
-> [Prop Name] -> Type Name -> Maybe Range -> Schema Name
forall n.
[TParam n] -> [Prop n] -> Type n -> Maybe Range -> Schema n
Forall [TParam Name]
ps' [Prop Name]
p' Type Name
ty' Maybe Range
loc)

-- | Rename a qualified thing.
renameQual :: [TParam PName] -> [Prop PName] ->
              ([TParam Name] -> [Prop Name] -> RenameM a) ->
              RenameM (NamingEnv, a)
renameQual :: [TParam PName]
-> [Prop PName]
-> ([TParam Name] -> [Prop Name] -> RenameM a)
-> RenameM (NamingEnv, a)
renameQual [TParam PName]
as [Prop PName]
ps [TParam Name] -> [Prop Name] -> RenameM a
k =
  do NamingEnv
env <- (Supply -> (NamingEnv, Supply)) -> RenameM NamingEnv
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply ([TParam PName] -> Supply -> (NamingEnv, Supply)
forall a. BindsNames a => a -> Supply -> (NamingEnv, Supply)
namingEnv' [TParam PName]
as)
     a
res <- NamingEnv -> RenameM a -> RenameM a
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
env (RenameM a -> RenameM a) -> RenameM a -> RenameM a
forall a b. (a -> b) -> a -> b
$ do [TParam Name]
as' <- (TParam PName -> RenameM (TParam Name))
-> [TParam PName] -> RenameM [TParam Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TParam PName -> RenameM (TParam Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TParam PName]
as
                                 [Prop Name]
ps' <- (Prop PName -> RenameM (Prop Name))
-> [Prop PName] -> RenameM [Prop Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Prop PName -> RenameM (Prop Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Prop PName]
ps
                                 [TParam Name] -> [Prop Name] -> RenameM a
k [TParam Name]
as' [Prop Name]
ps'
     (NamingEnv, a) -> RenameM (NamingEnv, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamingEnv
env,a
res)

instance Rename TParam where
  rename :: TParam PName -> RenameM (TParam Name)
rename TParam { Maybe Range
Maybe Kind
PName
tpRange :: forall n. TParam n -> Maybe Range
tpKind :: forall n. TParam n -> Maybe Kind
tpName :: forall n. TParam n -> n
tpRange :: Maybe Range
tpKind :: Maybe Kind
tpName :: PName
.. } =
    do Name
n <- PName -> RenameM Name
renameType PName
tpName
       TParam Name -> RenameM (TParam Name)
forall (m :: * -> *) a. Monad m => a -> m a
return TParam :: forall n. n -> Maybe Kind -> Maybe Range -> TParam n
TParam { tpName :: Name
tpName = Name
n, Maybe Range
Maybe Kind
tpRange :: Maybe Range
tpKind :: Maybe Kind
tpRange :: Maybe Range
tpKind :: Maybe Kind
.. }

instance Rename Prop where
  rename :: Prop PName -> RenameM (Prop Name)
rename (CType Type PName
t) = Type Name -> Prop Name
forall n. Type n -> Prop n
CType (Type Name -> Prop Name)
-> RenameM (Type Name) -> RenameM (Prop Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
t


instance Rename Type where
  rename :: Type PName -> RenameM (Type Name)
rename Type PName
ty0 =
    case Type PName
ty0 of
      TFun Type PName
a Type PName
b       -> Type Name -> Type Name -> Type Name
forall n. Type n -> Type n -> Type n
TFun (Type Name -> Type Name -> Type Name)
-> RenameM (Type Name) -> RenameM (Type Name -> Type Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
a RenameM (Type Name -> Type Name)
-> RenameM (Type Name) -> RenameM (Type Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
b
      TSeq Type PName
n Type PName
a       -> Type Name -> Type Name -> Type Name
forall n. Type n -> Type n -> Type n
TSeq (Type Name -> Type Name -> Type Name)
-> RenameM (Type Name) -> RenameM (Type Name -> Type Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
n RenameM (Type Name -> Type Name)
-> RenameM (Type Name) -> RenameM (Type Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
a
      Type PName
TBit           -> Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Type Name
forall n. Type n
TBit
      TNum Integer
c         -> Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Type Name
forall n. Integer -> Type n
TNum Integer
c)
      TChar Char
c        -> Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Type Name
forall n. Char -> Type n
TChar Char
c)
      TUser PName
qn [Type PName]
ps    -> Name -> [Type Name] -> Type Name
forall n. n -> [Type n] -> Type n
TUser    (Name -> [Type Name] -> Type Name)
-> RenameM Name -> RenameM ([Type Name] -> Type Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PName -> RenameM Name
renameType PName
qn RenameM ([Type Name] -> Type Name)
-> RenameM [Type Name] -> RenameM (Type Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type PName -> RenameM (Type Name))
-> [Type PName] -> RenameM [Type Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Type PName]
ps
      TTyApp [Named (Type PName)]
fs      -> [Named (Type Name)] -> Type Name
forall n. [Named (Type n)] -> Type n
TTyApp   ([Named (Type Name)] -> Type Name)
-> RenameM [Named (Type Name)] -> RenameM (Type Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Named (Type PName) -> RenameM (Named (Type Name)))
-> [Named (Type PName)] -> RenameM [Named (Type Name)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Type PName -> RenameM (Type Name))
-> Named (Type PName) -> RenameM (Named (Type Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) [Named (Type PName)]
fs
      TRecord Rec (Type PName)
fs     -> Rec (Type Name) -> Type Name
forall n. Rec (Type n) -> Type n
TRecord  (Rec (Type Name) -> Type Name)
-> RenameM (Rec (Type Name)) -> RenameM (Type Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Range, Type PName) -> RenameM (Range, Type Name))
-> Rec (Type PName) -> RenameM (Rec (Type Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Type PName -> RenameM (Type Name))
-> (Range, Type PName) -> RenameM (Range, Type Name)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) Rec (Type PName)
fs
      TTuple [Type PName]
fs      -> [Type Name] -> Type Name
forall n. [Type n] -> Type n
TTuple   ([Type Name] -> Type Name)
-> RenameM [Type Name] -> RenameM (Type Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type PName -> RenameM (Type Name))
-> [Type PName] -> RenameM [Type Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Type PName]
fs
      Type PName
TWild          -> Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Type Name
forall n. Type n
TWild
      TLocated Type PName
t' Range
r  -> Range -> RenameM (Type Name) -> RenameM (Type Name)
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
r (Type Name -> Range -> Type Name
forall n. Type n -> Range -> Type n
TLocated (Type Name -> Range -> Type Name)
-> RenameM (Type Name) -> RenameM (Range -> Type Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
t' RenameM (Range -> Type Name)
-> RenameM Range -> RenameM (Type Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range -> RenameM Range
forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
r)
      TParens Type PName
t'     -> Type Name -> Type Name
forall n. Type n -> Type n
TParens (Type Name -> Type Name)
-> RenameM (Type Name) -> RenameM (Type Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
t'
      TInfix Type PName
a Located PName
o Fixity
_ Type PName
b -> do (Located Name, Fixity)
o' <- Located PName -> RenameM (Located Name, Fixity)
renameTypeOp Located PName
o
                           Type Name
a' <- Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
a
                           Type Name
b' <- Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
b
                           Type Name
-> (Located Name, Fixity) -> Type Name -> RenameM (Type Name)
mkTInfix Type Name
a' (Located Name, Fixity)
o' Type Name
b'

mkTInfix :: Type Name -> (Located Name, Fixity) -> Type Name -> RenameM (Type Name)

mkTInfix :: Type Name
-> (Located Name, Fixity) -> Type Name -> RenameM (Type Name)
mkTInfix t :: Type Name
t@(TInfix Type Name
x Located Name
o1 Fixity
f1 Type Name
y) op :: (Located Name, Fixity)
op@(Located Name
o2,Fixity
f2) Type Name
z =
  case Fixity -> Fixity -> FixityCmp
compareFixity Fixity
f1 Fixity
f2 of
    FixityCmp
FCLeft  -> Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type Name -> Located Name -> Fixity -> Type Name -> Type Name
forall n. Type n -> Located n -> Fixity -> Type n -> Type n
TInfix Type Name
t Located Name
o2 Fixity
f2 Type Name
z)
    FixityCmp
FCRight -> do Type Name
r <- Type Name
-> (Located Name, Fixity) -> Type Name -> RenameM (Type Name)
mkTInfix Type Name
y (Located Name, Fixity)
op Type Name
z
                  Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type Name -> Located Name -> Fixity -> Type Name -> Type Name
forall n. Type n -> Located n -> Fixity -> Type n -> Type n
TInfix Type Name
x Located Name
o1 Fixity
f1 Type Name
r)
    FixityCmp
FCError -> do (NameDisp -> RenamerError) -> RenameM ()
record (Located Name
-> Fixity -> Located Name -> Fixity -> NameDisp -> RenamerError
FixityError Located Name
o1 Fixity
f1 Located Name
o2 Fixity
f2)
                  Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type Name -> Located Name -> Fixity -> Type Name -> Type Name
forall n. Type n -> Located n -> Fixity -> Type n -> Type n
TInfix Type Name
t Located Name
o2 Fixity
f2 Type Name
z)

mkTInfix (TLocated Type Name
t' Range
_) (Located Name, Fixity)
op Type Name
z =
  Type Name
-> (Located Name, Fixity) -> Type Name -> RenameM (Type Name)
mkTInfix Type Name
t' (Located Name, Fixity)
op Type Name
z

mkTInfix Type Name
t (Located Name
o,Fixity
f) Type Name
z =
  Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type Name -> Located Name -> Fixity -> Type Name -> Type Name
forall n. Type n -> Located n -> Fixity -> Type n -> Type n
TInfix Type Name
t Located Name
o Fixity
f Type Name
z)


-- | Rename a binding.
instance Rename Bind where
  rename :: Bind PName -> RenameM (Bind Name)
rename Bind PName
b      = do
    Located Name
n'    <- (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated PName -> RenameM Name
renameVar (Bind PName -> Located PName
forall name. Bind name -> Located name
bName Bind PName
b)
    Maybe (NamingEnv, Schema Name)
mbSig <- (Schema PName -> RenameM (NamingEnv, Schema Name))
-> Maybe (Schema PName) -> RenameM (Maybe (NamingEnv, Schema Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Schema PName -> RenameM (NamingEnv, Schema Name)
renameSchema (Bind PName -> Maybe (Schema PName)
forall name. Bind name -> Maybe (Schema name)
bSignature Bind PName
b)
    Maybe NamingEnv -> RenameM (Bind Name) -> RenameM (Bind Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames ((NamingEnv, Schema Name) -> NamingEnv
forall a b. (a, b) -> a
fst ((NamingEnv, Schema Name) -> NamingEnv)
-> Maybe (NamingEnv, Schema Name) -> Maybe NamingEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe (NamingEnv, Schema Name)
mbSig) (RenameM (Bind Name) -> RenameM (Bind Name))
-> RenameM (Bind Name) -> RenameM (Bind Name)
forall a b. (a -> b) -> a -> b
$
      do (NamingEnv
patEnv,[Pattern Name]
pats') <- [Pattern PName] -> RenameM (NamingEnv, [Pattern Name])
renamePats (Bind PName -> [Pattern PName]
forall name. Bind name -> [Pattern name]
bParams Bind PName
b)
         -- NOTE: renamePats will generate warnings, so we don't need to trigger
         -- them again here.
         Located (BindDef Name)
e'             <- EnvCheck
-> NamingEnv
-> RenameM (Located (BindDef Name))
-> RenameM (Located (BindDef Name))
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
patEnv ((BindDef PName -> RenameM (BindDef Name))
-> Located (BindDef PName) -> RenameM (Located (BindDef Name))
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated BindDef PName -> RenameM (BindDef Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (Bind PName -> Located (BindDef PName)
forall name. Bind name -> Located (BindDef name)
bDef Bind PName
b))
         Bind Name -> RenameM (Bind Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Bind PName
b { bName :: Located Name
bName      = Located Name
n'
                  , bParams :: [Pattern Name]
bParams    = [Pattern Name]
pats'
                  , bDef :: Located (BindDef Name)
bDef       = Located (BindDef Name)
e'
                  , bSignature :: Maybe (Schema Name)
bSignature = (NamingEnv, Schema Name) -> Schema Name
forall a b. (a, b) -> b
snd ((NamingEnv, Schema Name) -> Schema Name)
-> Maybe (NamingEnv, Schema Name) -> Maybe (Schema Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe (NamingEnv, Schema Name)
mbSig
                  , bPragmas :: [Pragma]
bPragmas   = Bind PName -> [Pragma]
forall name. Bind name -> [Pragma]
bPragmas Bind PName
b
                  }

instance Rename BindDef where
  rename :: BindDef PName -> RenameM (BindDef Name)
rename BindDef PName
DPrim     = BindDef Name -> RenameM (BindDef Name)
forall (m :: * -> *) a. Monad m => a -> m a
return BindDef Name
forall name. BindDef name
DPrim
  rename (DExpr Expr PName
e) = Expr Name -> BindDef Name
forall name. Expr name -> BindDef name
DExpr (Expr Name -> BindDef Name)
-> RenameM (Expr Name) -> RenameM (BindDef Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e

-- NOTE: this only renames types within the pattern.
instance Rename Pattern where
  rename :: Pattern PName -> RenameM (Pattern Name)
rename Pattern PName
p      = case Pattern PName
p of
    PVar Located PName
lv         -> Located Name -> Pattern Name
forall n. Located n -> Pattern n
PVar (Located Name -> Pattern Name)
-> RenameM (Located Name) -> RenameM (Pattern Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated PName -> RenameM Name
renameVar Located PName
lv
    Pattern PName
PWild           -> Pattern Name -> RenameM (Pattern Name)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern Name
forall n. Pattern n
PWild
    PTuple [Pattern PName]
ps       -> [Pattern Name] -> Pattern Name
forall n. [Pattern n] -> Pattern n
PTuple   ([Pattern Name] -> Pattern Name)
-> RenameM [Pattern Name] -> RenameM (Pattern Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern PName -> RenameM (Pattern Name))
-> [Pattern PName] -> RenameM [Pattern Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Pattern PName]
ps
    PRecord Rec (Pattern PName)
nps     -> Rec (Pattern Name) -> Pattern Name
forall n. Rec (Pattern n) -> Pattern n
PRecord  (Rec (Pattern Name) -> Pattern Name)
-> RenameM (Rec (Pattern Name)) -> RenameM (Pattern Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Range, Pattern PName) -> RenameM (Range, Pattern Name))
-> Rec (Pattern PName) -> RenameM (Rec (Pattern Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Pattern PName -> RenameM (Pattern Name))
-> (Range, Pattern PName) -> RenameM (Range, Pattern Name)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) Rec (Pattern PName)
nps
    PList [Pattern PName]
elems     -> [Pattern Name] -> Pattern Name
forall n. [Pattern n] -> Pattern n
PList    ([Pattern Name] -> Pattern Name)
-> RenameM [Pattern Name] -> RenameM (Pattern Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern PName -> RenameM (Pattern Name))
-> [Pattern PName] -> RenameM [Pattern Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Pattern PName]
elems
    PTyped Pattern PName
p' Type PName
t     -> Pattern Name -> Type Name -> Pattern Name
forall n. Pattern n -> Type n -> Pattern n
PTyped   (Pattern Name -> Type Name -> Pattern Name)
-> RenameM (Pattern Name) -> RenameM (Type Name -> Pattern Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p'    RenameM (Type Name -> Pattern Name)
-> RenameM (Type Name) -> RenameM (Pattern Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
t
    PSplit Pattern PName
l Pattern PName
r      -> Pattern Name -> Pattern Name -> Pattern Name
forall n. Pattern n -> Pattern n -> Pattern n
PSplit   (Pattern Name -> Pattern Name -> Pattern Name)
-> RenameM (Pattern Name) -> RenameM (Pattern Name -> Pattern Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
l     RenameM (Pattern Name -> Pattern Name)
-> RenameM (Pattern Name) -> RenameM (Pattern Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
r
    PLocated Pattern PName
p' Range
loc -> Range -> RenameM (Pattern Name) -> RenameM (Pattern Name)
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
loc
                     (RenameM (Pattern Name) -> RenameM (Pattern Name))
-> RenameM (Pattern Name) -> RenameM (Pattern Name)
forall a b. (a -> b) -> a -> b
$ Pattern Name -> Range -> Pattern Name
forall n. Pattern n -> Range -> Pattern n
PLocated (Pattern Name -> Range -> Pattern Name)
-> RenameM (Pattern Name) -> RenameM (Range -> Pattern Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p'    RenameM (Range -> Pattern Name)
-> RenameM Range -> RenameM (Pattern Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range -> RenameM Range
forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
loc

-- | Note that after this point the @->@ updates have an explicit function
-- and there are no more nested updates.
instance Rename UpdField where
  rename :: UpdField PName -> RenameM (UpdField Name)
rename (UpdField UpdHow
h [Located Selector]
ls Expr PName
e) =
    -- The plan:
    -- x =  e       ~~~>        x = e
    -- x -> e       ~~~>        x -> \x -> e
    -- x.y = e      ~~~>        x -> { _ | y = e }
    -- x.y -> e     ~~~>        x -> { _ | y -> e }
    case [Located Selector]
ls of
      Located Selector
l : [Located Selector]
more ->
       case [Located Selector]
more of
         [] -> case UpdHow
h of
                 UpdHow
UpdSet -> UpdHow -> [Located Selector] -> Expr Name -> UpdField Name
forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
UpdSet [Located Selector
l] (Expr Name -> UpdField Name)
-> RenameM (Expr Name) -> RenameM (UpdField Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
                 UpdHow
UpdFun -> UpdHow -> [Located Selector] -> Expr Name -> UpdField Name
forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
UpdFun [Located Selector
l] (Expr Name -> UpdField Name)
-> RenameM (Expr Name) -> RenameM (UpdField Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename ([Pattern PName] -> Expr PName -> Expr PName
forall n. [Pattern n] -> Expr n -> Expr n
EFun [Located PName -> Pattern PName
forall n. Located n -> Pattern n
PVar Located PName
p] Expr PName
e)
                       where
                       p :: Located PName
p = Ident -> PName
UnQual (Ident -> PName) -> (Selector -> Ident) -> Selector -> PName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> Ident
selName (Selector -> PName) -> Located Selector -> Located PName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located Selector] -> Located Selector
forall a. [a] -> a
last [Located Selector]
ls
         [Located Selector]
_ -> UpdHow -> [Located Selector] -> Expr Name -> UpdField Name
forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
UpdFun [Located Selector
l] (Expr Name -> UpdField Name)
-> RenameM (Expr Name) -> RenameM (UpdField Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename (Maybe (Expr PName) -> [UpdField PName] -> Expr PName
forall n. Maybe (Expr n) -> [UpdField n] -> Expr n
EUpd Maybe (Expr PName)
forall a. Maybe a
Nothing [ UpdHow -> [Located Selector] -> Expr PName -> UpdField PName
forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
h [Located Selector]
more Expr PName
e])
      [] -> String -> [String] -> RenameM (UpdField Name)
forall a. HasCallStack => String -> [String] -> a
panic String
"rename@UpdField" [ String
"Empty label list." ]


instance Rename Expr where
  rename :: Expr PName -> RenameM (Expr Name)
rename Expr PName
expr = case Expr PName
expr of
    EVar PName
n          -> Name -> Expr Name
forall n. n -> Expr n
EVar (Name -> Expr Name) -> RenameM Name -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PName -> RenameM Name
renameVar PName
n
    ELit Literal
l          -> Expr Name -> RenameM (Expr Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Literal -> Expr Name
forall n. Literal -> Expr n
ELit Literal
l)
    ENeg Expr PName
e          -> Expr Name -> Expr Name
forall n. Expr n -> Expr n
ENeg    (Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
    EComplement Expr PName
e   -> Expr Name -> Expr Name
forall n. Expr n -> Expr n
EComplement
                               (Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
    EGenerate Expr PName
e     -> Expr Name -> Expr Name
forall n. Expr n -> Expr n
EGenerate
                               (Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
    ETuple [Expr PName]
es       -> [Expr Name] -> Expr Name
forall n. [Expr n] -> Expr n
ETuple  ([Expr Name] -> Expr Name)
-> RenameM [Expr Name] -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr PName -> RenameM (Expr Name))
-> [Expr PName] -> RenameM [Expr Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Expr PName]
es
    ERecord Rec (Expr PName)
fs      -> Rec (Expr Name) -> Expr Name
forall n. Rec (Expr n) -> Expr n
ERecord (Rec (Expr Name) -> Expr Name)
-> RenameM (Rec (Expr Name)) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Range, Expr PName) -> RenameM (Range, Expr Name))
-> Rec (Expr PName) -> RenameM (Rec (Expr Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Expr PName -> RenameM (Expr Name))
-> (Range, Expr PName) -> RenameM (Range, Expr Name)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) Rec (Expr PName)
fs
    ESel Expr PName
e' Selector
s       -> Expr Name -> Selector -> Expr Name
forall n. Expr n -> Selector -> Expr n
ESel    (Expr Name -> Selector -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Selector -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' RenameM (Selector -> Expr Name)
-> RenameM Selector -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Selector -> RenameM Selector
forall (f :: * -> *) a. Applicative f => a -> f a
pure Selector
s
    EUpd Maybe (Expr PName)
mb [UpdField PName]
fs      -> do [UpdField PName] -> RenameM ()
checkLabels [UpdField PName]
fs
                          Maybe (Expr Name) -> [UpdField Name] -> Expr Name
forall n. Maybe (Expr n) -> [UpdField n] -> Expr n
EUpd (Maybe (Expr Name) -> [UpdField Name] -> Expr Name)
-> RenameM (Maybe (Expr Name))
-> RenameM ([UpdField Name] -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr PName -> RenameM (Expr Name))
-> Maybe (Expr PName) -> RenameM (Maybe (Expr Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Expr PName)
mb RenameM ([UpdField Name] -> Expr Name)
-> RenameM [UpdField Name] -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (UpdField PName -> RenameM (UpdField Name))
-> [UpdField PName] -> RenameM [UpdField Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse UpdField PName -> RenameM (UpdField Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [UpdField PName]
fs
    EList [Expr PName]
es        -> [Expr Name] -> Expr Name
forall n. [Expr n] -> Expr n
EList   ([Expr Name] -> Expr Name)
-> RenameM [Expr Name] -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr PName -> RenameM (Expr Name))
-> [Expr PName] -> RenameM [Expr Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Expr PName]
es
    EFromTo Type PName
s Maybe (Type PName)
n Type PName
e Maybe (Type PName)
t -> Type Name
-> Maybe (Type Name) -> Type Name -> Maybe (Type Name) -> Expr Name
forall n.
Type n -> Maybe (Type n) -> Type n -> Maybe (Type n) -> Expr n
EFromTo (Type Name
 -> Maybe (Type Name)
 -> Type Name
 -> Maybe (Type Name)
 -> Expr Name)
-> RenameM (Type Name)
-> RenameM
     (Maybe (Type Name) -> Type Name -> Maybe (Type Name) -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
s
                               RenameM
  (Maybe (Type Name) -> Type Name -> Maybe (Type Name) -> Expr Name)
-> RenameM (Maybe (Type Name))
-> RenameM (Type Name -> Maybe (Type Name) -> Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type PName -> RenameM (Type Name))
-> Maybe (Type PName) -> RenameM (Maybe (Type Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Type PName)
n
                               RenameM (Type Name -> Maybe (Type Name) -> Expr Name)
-> RenameM (Type Name) -> RenameM (Maybe (Type Name) -> Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
e
                               RenameM (Maybe (Type Name) -> Expr Name)
-> RenameM (Maybe (Type Name)) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type PName -> RenameM (Type Name))
-> Maybe (Type PName) -> RenameM (Maybe (Type Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Type PName)
t
    EInfFrom Expr PName
a Maybe (Expr PName)
b    -> Expr Name -> Maybe (Expr Name) -> Expr Name
forall n. Expr n -> Maybe (Expr n) -> Expr n
EInfFrom(Expr Name -> Maybe (Expr Name) -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Maybe (Expr Name) -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
a  RenameM (Maybe (Expr Name) -> Expr Name)
-> RenameM (Maybe (Expr Name)) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr PName -> RenameM (Expr Name))
-> Maybe (Expr PName) -> RenameM (Maybe (Expr Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Maybe (Expr PName)
b
    EComp Expr PName
e' [[Match PName]]
bs     -> do [(NamingEnv, [Match Name])]
arms' <- ([Match PName] -> RenameM (NamingEnv, [Match Name]))
-> [[Match PName]] -> RenameM [(NamingEnv, [Match Name])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [Match PName] -> RenameM (NamingEnv, [Match Name])
renameArm [[Match PName]]
bs
                          let ([NamingEnv]
envs,[[Match Name]]
bs') = [(NamingEnv, [Match Name])] -> ([NamingEnv], [[Match Name]])
forall a b. [(a, b)] -> ([a], [b])
unzip [(NamingEnv, [Match Name])]
arms'
                          -- NOTE: renameArm will generate shadowing warnings; we only
                          -- need to check for repeated names across multiple arms
                          EnvCheck
-> [NamingEnv] -> RenameM (Expr Name) -> RenameM (Expr Name)
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckOverlap [NamingEnv]
envs (Expr Name -> [[Match Name]] -> Expr Name
forall n. Expr n -> [[Match n]] -> Expr n
EComp (Expr Name -> [[Match Name]] -> Expr Name)
-> RenameM (Expr Name) -> RenameM ([[Match Name]] -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' RenameM ([[Match Name]] -> Expr Name)
-> RenameM [[Match Name]] -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[Match Name]] -> RenameM [[Match Name]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Match Name]]
bs')
    EApp Expr PName
f Expr PName
x        -> Expr Name -> Expr Name -> Expr Name
forall n. Expr n -> Expr n -> Expr n
EApp    (Expr Name -> Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
f  RenameM (Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
x
    EAppT Expr PName
f [TypeInst PName]
ti      -> Expr Name -> [TypeInst Name] -> Expr Name
forall n. Expr n -> [TypeInst n] -> Expr n
EAppT   (Expr Name -> [TypeInst Name] -> Expr Name)
-> RenameM (Expr Name) -> RenameM ([TypeInst Name] -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
f  RenameM ([TypeInst Name] -> Expr Name)
-> RenameM [TypeInst Name] -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TypeInst PName -> RenameM (TypeInst Name))
-> [TypeInst PName] -> RenameM [TypeInst Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TypeInst PName -> RenameM (TypeInst Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TypeInst PName]
ti
    EIf Expr PName
b Expr PName
t Expr PName
f       -> Expr Name -> Expr Name -> Expr Name -> Expr Name
forall n. Expr n -> Expr n -> Expr n -> Expr n
EIf     (Expr Name -> Expr Name -> Expr Name -> Expr Name)
-> RenameM (Expr Name)
-> RenameM (Expr Name -> Expr Name -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
b  RenameM (Expr Name -> Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name -> Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
t  RenameM (Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
f
    EWhere Expr PName
e' [Decl PName]
ds    -> do ModName
ns <- RenameM ModName
getNS
                          [InModule (Decl PName)]
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames ((Decl PName -> InModule (Decl PName))
-> [Decl PName] -> [InModule (Decl PName)]
forall a b. (a -> b) -> [a] -> [b]
map (ModName -> Decl PName -> InModule (Decl PName)
forall a. ModName -> a -> InModule a
InModule ModName
ns) [Decl PName]
ds) (RenameM (Expr Name) -> RenameM (Expr Name))
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall a b. (a -> b) -> a -> b
$
                            Expr Name -> [Decl Name] -> Expr Name
forall n. Expr n -> [Decl n] -> Expr n
EWhere (Expr Name -> [Decl Name] -> Expr Name)
-> RenameM (Expr Name) -> RenameM ([Decl Name] -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' RenameM ([Decl Name] -> Expr Name)
-> RenameM [Decl Name] -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Decl PName -> RenameM (Decl Name))
-> [Decl PName] -> RenameM [Decl Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Decl PName -> RenameM (Decl Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Decl PName]
ds
    ETyped Expr PName
e' Type PName
ty    -> Expr Name -> Type Name -> Expr Name
forall n. Expr n -> Type n -> Expr n
ETyped  (Expr Name -> Type Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Type Name -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' RenameM (Type Name -> Expr Name)
-> RenameM (Type Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty
    ETypeVal Type PName
ty     -> Type Name -> Expr Name
forall n. Type n -> Expr n
ETypeVal(Type Name -> Expr Name)
-> RenameM (Type Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty
    EFun [Pattern PName]
ps Expr PName
e'      -> do (NamingEnv
env,[Pattern Name]
ps') <- [Pattern PName] -> RenameM (NamingEnv, [Pattern Name])
renamePats [Pattern PName]
ps
                          -- NOTE: renamePats will generate warnings, so we don't
                          -- need to duplicate them here
                          EnvCheck -> NamingEnv -> RenameM (Expr Name) -> RenameM (Expr Name)
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
env ([Pattern Name] -> Expr Name -> Expr Name
forall n. [Pattern n] -> Expr n -> Expr n
EFun [Pattern Name]
ps' (Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e')
    ELocated Expr PName
e' Range
r   -> Range -> RenameM (Expr Name) -> RenameM (Expr Name)
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
r
                     (RenameM (Expr Name) -> RenameM (Expr Name))
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall a b. (a -> b) -> a -> b
$ Expr Name -> Range -> Expr Name
forall n. Expr n -> Range -> Expr n
ELocated (Expr Name -> Range -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Range -> Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e' RenameM (Range -> Expr Name)
-> RenameM Range -> RenameM (Expr Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range -> RenameM Range
forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
r

    ESplit Expr PName
e        -> Expr Name -> Expr Name
forall n. Expr n -> Expr n
ESplit  (Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
    EParens Expr PName
p       -> Expr Name -> Expr Name
forall n. Expr n -> Expr n
EParens (Expr Name -> Expr Name)
-> RenameM (Expr Name) -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
p
    EInfix Expr PName
x Located PName
y Fixity
_ Expr PName
z  -> do (Located Name, Fixity)
op <- Located PName -> RenameM (Located Name, Fixity)
renameOp Located PName
y
                          Expr Name
x' <- Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
x
                          Expr Name
z' <- Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
z
                          Expr Name
-> (Located Name, Fixity) -> Expr Name -> RenameM (Expr Name)
mkEInfix Expr Name
x' (Located Name, Fixity)
op Expr Name
z'


checkLabels :: [UpdField PName] -> RenameM ()
checkLabels :: [UpdField PName] -> RenameM ()
checkLabels = ([[Located Selector]]
 -> [Located Selector] -> RenameM [[Located Selector]])
-> [[Located Selector]] -> [[Located Selector]] -> RenameM ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ [[Located Selector]]
-> [Located Selector] -> RenameM [[Located Selector]]
check [] ([[Located Selector]] -> RenameM ())
-> ([UpdField PName] -> [[Located Selector]])
-> [UpdField PName]
-> RenameM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UpdField PName -> [Located Selector])
-> [UpdField PName] -> [[Located Selector]]
forall a b. (a -> b) -> [a] -> [b]
map UpdField PName -> [Located Selector]
forall n. UpdField n -> [Located Selector]
labs
  where
  labs :: UpdField n -> [Located Selector]
labs (UpdField UpdHow
_ [Located Selector]
ls Expr n
_) = [Located Selector]
ls

  check :: [[Located Selector]]
-> [Located Selector] -> RenameM [[Located Selector]]
check [[Located Selector]]
done [Located Selector]
l =
    do case ([Located Selector] -> Bool)
-> [[Located Selector]] -> Maybe [Located Selector]
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ([Located Selector] -> [Located Selector] -> Bool
overlap [Located Selector]
l) [[Located Selector]]
done of
         Just [Located Selector]
l' -> (NameDisp -> RenamerError) -> RenameM ()
record (Located [Selector]
-> Located [Selector] -> NameDisp -> RenamerError
OverlappingRecordUpdate ([Located Selector] -> Located [Selector]
forall b. [Located b] -> Located [b]
reLoc [Located Selector]
l) ([Located Selector] -> Located [Selector]
forall b. [Located b] -> Located [b]
reLoc [Located Selector]
l'))
         Maybe [Located Selector]
Nothing -> () -> RenameM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
       [[Located Selector]] -> RenameM [[Located Selector]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Located Selector]
l [Located Selector] -> [[Located Selector]] -> [[Located Selector]]
forall a. a -> [a] -> [a]
: [[Located Selector]]
done)

  overlap :: [Located Selector] -> [Located Selector] -> Bool
overlap [Located Selector]
xs [Located Selector]
ys =
    case ([Located Selector]
xs,[Located Selector]
ys) of
      ([],[Located Selector]
_)  -> Bool
True
      ([Located Selector]
_, []) -> Bool
True
      (Located Selector
x : [Located Selector]
xs', Located Selector
y : [Located Selector]
ys') -> Located Selector -> Located Selector -> Bool
same Located Selector
x Located Selector
y Bool -> Bool -> Bool
&& [Located Selector] -> [Located Selector] -> Bool
overlap [Located Selector]
xs' [Located Selector]
ys'

  same :: Located Selector -> Located Selector -> Bool
same Located Selector
x Located Selector
y =
    case (Located Selector -> Selector
forall a. Located a -> a
thing Located Selector
x, Located Selector -> Selector
forall a. Located a -> a
thing Located Selector
y) of
      (TupleSel Int
a Maybe Int
_, TupleSel Int
b Maybe Int
_)   -> Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b
      (ListSel  Int
a Maybe Int
_, ListSel  Int
b Maybe Int
_)   -> Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b
      (RecordSel Ident
a Maybe [Ident]
_, RecordSel Ident
b Maybe [Ident]
_) -> Ident
a Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
b
      (Selector, Selector)
_                              -> Bool
False

  reLoc :: [Located b] -> Located [b]
reLoc [Located b]
xs = ([Located b] -> Located b
forall a. [a] -> a
head [Located b]
xs) { thing :: [b]
thing = (Located b -> b) -> [Located b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Located b -> b
forall a. Located a -> a
thing [Located b]
xs }


mkEInfix :: Expr Name             -- ^ May contain infix expressions
         -> (Located Name,Fixity) -- ^ The operator to use
         -> Expr Name             -- ^ Will not contain infix expressions
         -> RenameM (Expr Name)

mkEInfix :: Expr Name
-> (Located Name, Fixity) -> Expr Name -> RenameM (Expr Name)
mkEInfix e :: Expr Name
e@(EInfix Expr Name
x Located Name
o1 Fixity
f1 Expr Name
y) op :: (Located Name, Fixity)
op@(Located Name
o2,Fixity
f2) Expr Name
z =
   case Fixity -> Fixity -> FixityCmp
compareFixity Fixity
f1 Fixity
f2 of
     FixityCmp
FCLeft  -> Expr Name -> RenameM (Expr Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Name -> Located Name -> Fixity -> Expr Name -> Expr Name
forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
e Located Name
o2 Fixity
f2 Expr Name
z)

     FixityCmp
FCRight -> do Expr Name
r <- Expr Name
-> (Located Name, Fixity) -> Expr Name -> RenameM (Expr Name)
mkEInfix Expr Name
y (Located Name, Fixity)
op Expr Name
z
                   Expr Name -> RenameM (Expr Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Name -> Located Name -> Fixity -> Expr Name -> Expr Name
forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
x Located Name
o1 Fixity
f1 Expr Name
r)

     FixityCmp
FCError -> do (NameDisp -> RenamerError) -> RenameM ()
record (Located Name
-> Fixity -> Located Name -> Fixity -> NameDisp -> RenamerError
FixityError Located Name
o1 Fixity
f1 Located Name
o2 Fixity
f2)
                   Expr Name -> RenameM (Expr Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Name -> Located Name -> Fixity -> Expr Name -> Expr Name
forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
e Located Name
o2 Fixity
f2 Expr Name
z)

mkEInfix (ELocated Expr Name
e' Range
_) (Located Name, Fixity)
op Expr Name
z =
     Expr Name
-> (Located Name, Fixity) -> Expr Name -> RenameM (Expr Name)
mkEInfix Expr Name
e' (Located Name, Fixity)
op Expr Name
z

mkEInfix Expr Name
e (Located Name
o,Fixity
f) Expr Name
z =
     Expr Name -> RenameM (Expr Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Name -> Located Name -> Fixity -> Expr Name -> Expr Name
forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix Expr Name
e Located Name
o Fixity
f Expr Name
z)


renameOp :: Located PName -> RenameM (Located Name, Fixity)
renameOp :: Located PName -> RenameM (Located Name, Fixity)
renameOp Located PName
ln =
  Located PName
-> RenameM (Located Name, Fixity) -> RenameM (Located Name, Fixity)
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Located PName
ln (RenameM (Located Name, Fixity) -> RenameM (Located Name, Fixity))
-> RenameM (Located Name, Fixity) -> RenameM (Located Name, Fixity)
forall a b. (a -> b) -> a -> b
$
  do Name
n <- PName -> RenameM Name
renameVar (Located PName -> PName
forall a. Located a -> a
thing Located PName
ln)
     Fixity
fixity <- Name -> RenameM Fixity
lookupFixity Name
n
     (Located Name, Fixity) -> RenameM (Located Name, Fixity)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located PName
ln { thing :: Name
thing = Name
n }, Fixity
fixity)

renameTypeOp :: Located PName -> RenameM (Located Name, Fixity)
renameTypeOp :: Located PName -> RenameM (Located Name, Fixity)
renameTypeOp Located PName
ln =
  Located PName
-> RenameM (Located Name, Fixity) -> RenameM (Located Name, Fixity)
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Located PName
ln (RenameM (Located Name, Fixity) -> RenameM (Located Name, Fixity))
-> RenameM (Located Name, Fixity) -> RenameM (Located Name, Fixity)
forall a b. (a -> b) -> a -> b
$
  do Name
n <- PName -> RenameM Name
renameType (Located PName -> PName
forall a. Located a -> a
thing Located PName
ln)
     Fixity
fixity <- Name -> RenameM Fixity
lookupFixity Name
n
     (Located Name, Fixity) -> RenameM (Located Name, Fixity)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located PName
ln { thing :: Name
thing = Name
n }, Fixity
fixity)

lookupFixity :: Name -> RenameM Fixity
lookupFixity :: Name -> RenameM Fixity
lookupFixity Name
n =
  case Name -> Maybe Fixity
nameFixity Name
n of
    Just Fixity
fixity -> Fixity -> RenameM Fixity
forall (m :: * -> *) a. Monad m => a -> m a
return Fixity
fixity
    Maybe Fixity
Nothing     -> Fixity -> RenameM Fixity
forall (m :: * -> *) a. Monad m => a -> m a
return Fixity
defaultFixity -- FIXME: should we raise an error instead?

instance Rename TypeInst where
  rename :: TypeInst PName -> RenameM (TypeInst Name)
rename TypeInst PName
ti = case TypeInst PName
ti of
    NamedInst Named (Type PName)
nty -> Named (Type Name) -> TypeInst Name
forall name. Named (Type name) -> TypeInst name
NamedInst (Named (Type Name) -> TypeInst Name)
-> RenameM (Named (Type Name)) -> RenameM (TypeInst Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type PName -> RenameM (Type Name))
-> Named (Type PName) -> RenameM (Named (Type Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Named (Type PName)
nty
    PosInst Type PName
ty    -> Type Name -> TypeInst Name
forall name. Type name -> TypeInst name
PosInst   (Type Name -> TypeInst Name)
-> RenameM (Type Name) -> RenameM (TypeInst Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty

renameArm :: [Match PName] -> RenameM (NamingEnv,[Match Name])

renameArm :: [Match PName] -> RenameM (NamingEnv, [Match Name])
renameArm (Match PName
m:[Match PName]
ms) =
  do (NamingEnv
me,Match Name
m') <- Match PName -> RenameM (NamingEnv, Match Name)
renameMatch Match PName
m
     -- NOTE: renameMatch will generate warnings, so we don't
     -- need to duplicate them here
     EnvCheck
-> NamingEnv
-> RenameM (NamingEnv, [Match Name])
-> RenameM (NamingEnv, [Match Name])
forall env a.
BindsNames env =>
EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' EnvCheck
CheckNone NamingEnv
me (RenameM (NamingEnv, [Match Name])
 -> RenameM (NamingEnv, [Match Name]))
-> RenameM (NamingEnv, [Match Name])
-> RenameM (NamingEnv, [Match Name])
forall a b. (a -> b) -> a -> b
$
       do (NamingEnv
env,[Match Name]
rest) <- [Match PName] -> RenameM (NamingEnv, [Match Name])
renameArm [Match PName]
ms

          -- NOTE: the inner environment shadows the outer one, for examples
          -- like this:
          --
          -- [ x | x <- xs, let x = 10 ]
          (NamingEnv, [Match Name]) -> RenameM (NamingEnv, [Match Name])
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
env NamingEnv -> NamingEnv -> NamingEnv
`shadowing` NamingEnv
me, Match Name
m'Match Name -> [Match Name] -> [Match Name]
forall a. a -> [a] -> [a]
:[Match Name]
rest)

renameArm [] =
     (NamingEnv, [Match Name]) -> RenameM (NamingEnv, [Match Name])
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
forall a. Monoid a => a
mempty,[])

-- | The name environment generated by a single match.
renameMatch :: Match PName -> RenameM (NamingEnv,Match Name)

renameMatch :: Match PName -> RenameM (NamingEnv, Match Name)
renameMatch (Match Pattern PName
p Expr PName
e) =
  do (NamingEnv
pe,Pattern Name
p') <- Pattern PName -> RenameM (NamingEnv, Pattern Name)
renamePat Pattern PName
p
     Expr Name
e'      <- Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
     (NamingEnv, Match Name) -> RenameM (NamingEnv, Match Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
pe,Pattern Name -> Expr Name -> Match Name
forall name. Pattern name -> Expr name -> Match name
Match Pattern Name
p' Expr Name
e')

renameMatch (MatchLet Bind PName
b) =
  do ModName
ns <- RenameM ModName
getNS
     NamingEnv
be <- (Supply -> (NamingEnv, Supply)) -> RenameM NamingEnv
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (InModule (Bind PName) -> Supply -> (NamingEnv, Supply)
forall a. BindsNames a => a -> Supply -> (NamingEnv, Supply)
namingEnv' (ModName -> Bind PName -> InModule (Bind PName)
forall a. ModName -> a -> InModule a
InModule ModName
ns Bind PName
b))
     Bind Name
b' <- NamingEnv -> RenameM (Bind Name) -> RenameM (Bind Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
be (Bind PName -> RenameM (Bind Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Bind PName
b)
     (NamingEnv, Match Name) -> RenameM (NamingEnv, Match Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
be,Bind Name -> Match Name
forall name. Bind name -> Match name
MatchLet Bind Name
b')

-- | Rename patterns, and collect the new environment that they introduce.
renamePat :: Pattern PName -> RenameM (NamingEnv, Pattern Name)
renamePat :: Pattern PName -> RenameM (NamingEnv, Pattern Name)
renamePat Pattern PName
p =
  do NamingEnv
pe <- Pattern PName -> RenameM NamingEnv
patternEnv Pattern PName
p
     Pattern Name
p' <- NamingEnv -> RenameM (Pattern Name) -> RenameM (Pattern Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
pe (Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p)
     (NamingEnv, Pattern Name) -> RenameM (NamingEnv, Pattern Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
pe, Pattern Name
p')



-- | Rename patterns, and collect the new environment that they introduce.
renamePats :: [Pattern PName] -> RenameM (NamingEnv,[Pattern Name])
renamePats :: [Pattern PName] -> RenameM (NamingEnv, [Pattern Name])
renamePats  = [Pattern PName] -> RenameM (NamingEnv, [Pattern Name])
loop
  where
  loop :: [Pattern PName] -> RenameM (NamingEnv, [Pattern Name])
loop [Pattern PName]
ps = case [Pattern PName]
ps of

    Pattern PName
p:[Pattern PName]
rest -> do
      NamingEnv
pe <- Pattern PName -> RenameM NamingEnv
patternEnv Pattern PName
p
      NamingEnv
-> RenameM (NamingEnv, [Pattern Name])
-> RenameM (NamingEnv, [Pattern Name])
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
pe (RenameM (NamingEnv, [Pattern Name])
 -> RenameM (NamingEnv, [Pattern Name]))
-> RenameM (NamingEnv, [Pattern Name])
-> RenameM (NamingEnv, [Pattern Name])
forall a b. (a -> b) -> a -> b
$
        do Pattern Name
p'           <- Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p
           (NamingEnv
env',[Pattern Name]
rest') <- [Pattern PName] -> RenameM (NamingEnv, [Pattern Name])
loop [Pattern PName]
rest
           (NamingEnv, [Pattern Name]) -> RenameM (NamingEnv, [Pattern Name])
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
pe NamingEnv -> NamingEnv -> NamingEnv
forall a. Monoid a => a -> a -> a
`mappend` NamingEnv
env', Pattern Name
p'Pattern Name -> [Pattern Name] -> [Pattern Name]
forall a. a -> [a] -> [a]
:[Pattern Name]
rest')

    [] -> (NamingEnv, [Pattern Name]) -> RenameM (NamingEnv, [Pattern Name])
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
forall a. Monoid a => a
mempty, [])

patternEnv :: Pattern PName -> RenameM NamingEnv
patternEnv :: Pattern PName -> RenameM NamingEnv
patternEnv  = Pattern PName -> RenameM NamingEnv
go
  where
  go :: Pattern PName -> RenameM NamingEnv
go (PVar Located { Range
PName
thing :: PName
srcRange :: Range
thing :: forall a. Located a -> a
srcRange :: forall a. Located a -> Range
.. }) =
    do Name
n <- (Supply -> (Name, Supply)) -> RenameM Name
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Ident -> Range -> Supply -> (Name, Supply)
mkParameter (PName -> Ident
getIdent PName
thing) Range
srcRange)
       NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (PName -> Name -> NamingEnv
singletonE PName
thing Name
n)

  go Pattern PName
PWild            = NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
forall a. Monoid a => a
mempty
  go (PTuple [Pattern PName]
ps)      = [Pattern PName] -> RenameM NamingEnv
bindVars [Pattern PName]
ps
  go (PRecord Rec (Pattern PName)
fs)     = [Pattern PName] -> RenameM NamingEnv
bindVars (((Range, Pattern PName) -> Pattern PName)
-> [(Range, Pattern PName)] -> [Pattern PName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Range, Pattern PName) -> Pattern PName
forall a b. (a, b) -> b
snd (Rec (Pattern PName) -> [(Range, Pattern PName)]
forall a b. RecordMap a b -> [b]
recordElements Rec (Pattern PName)
fs))
  go (PList [Pattern PName]
ps)       = (Pattern PName -> RenameM NamingEnv)
-> [Pattern PName] -> RenameM NamingEnv
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pattern PName -> RenameM NamingEnv
go [Pattern PName]
ps
  go (PTyped Pattern PName
p Type PName
ty)    = Pattern PName -> RenameM NamingEnv
go Pattern PName
p RenameM NamingEnv -> RenameM NamingEnv -> RenameM NamingEnv
forall a. Monoid a => a -> a -> a
`mappend` Type PName -> RenameM NamingEnv
typeEnv Type PName
ty
  go (PSplit Pattern PName
a Pattern PName
b)     = Pattern PName -> RenameM NamingEnv
go Pattern PName
a RenameM NamingEnv -> RenameM NamingEnv -> RenameM NamingEnv
forall a. Monoid a => a -> a -> a
`mappend` Pattern PName -> RenameM NamingEnv
go Pattern PName
b
  go (PLocated Pattern PName
p Range
loc) = Range -> RenameM NamingEnv -> RenameM NamingEnv
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
loc (Pattern PName -> RenameM NamingEnv
go Pattern PName
p)

  bindVars :: [Pattern PName] -> RenameM NamingEnv
bindVars []     = NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
forall a. Monoid a => a
mempty
  bindVars (Pattern PName
p:[Pattern PName]
ps) =
    do NamingEnv
env <- Pattern PName -> RenameM NamingEnv
go Pattern PName
p
       NamingEnv -> RenameM NamingEnv -> RenameM NamingEnv
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
env (RenameM NamingEnv -> RenameM NamingEnv)
-> RenameM NamingEnv -> RenameM NamingEnv
forall a b. (a -> b) -> a -> b
$
         do NamingEnv
rest <- [Pattern PName] -> RenameM NamingEnv
bindVars [Pattern PName]
ps
            NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
env NamingEnv -> NamingEnv -> NamingEnv
forall a. Monoid a => a -> a -> a
`mappend` NamingEnv
rest)


  typeEnv :: Type PName -> RenameM NamingEnv
typeEnv (TFun Type PName
a Type PName
b) = [Type PName] -> RenameM NamingEnv
bindTypes [Type PName
a,Type PName
b]
  typeEnv (TSeq Type PName
a Type PName
b) = [Type PName] -> RenameM NamingEnv
bindTypes [Type PName
a,Type PName
b]

  typeEnv Type PName
TBit       = NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
forall a. Monoid a => a
mempty
  typeEnv TNum{}     = NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
forall a. Monoid a => a
mempty
  typeEnv TChar{}    = NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
forall a. Monoid a => a
mempty

  typeEnv (TUser PName
pn [Type PName]
ps) =
    do Maybe Name
mb <- PName -> RenameM (Maybe Name)
typeExists PName
pn
       case Maybe Name
mb of

         -- The type is already bound, don't introduce anything.
         Just Name
_ -> [Type PName] -> RenameM NamingEnv
bindTypes [Type PName]
ps

         Maybe Name
Nothing

           -- The type isn't bound, and has no parameters, so it names a portion
           -- of the type of the pattern.
           | [Type PName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type PName]
ps ->
             do Range
loc <- RenameM Range
curLoc
                Name
n   <- (Supply -> (Name, Supply)) -> RenameM Name
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Ident -> Range -> Supply -> (Name, Supply)
mkParameter (PName -> Ident
getIdent PName
pn) Range
loc)
                NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (PName -> Name -> NamingEnv
singletonT PName
pn Name
n)

           -- This references a type synonym that's not in scope. Record an
           -- error and continue with a made up name.
           | Bool
otherwise ->
             do Range
loc <- RenameM Range
curLoc
                (NameDisp -> RenamerError) -> RenameM ()
record (Located PName -> NameDisp -> RenamerError
UnboundType (Range -> PName -> Located PName
forall a. Range -> a -> Located a
Located Range
loc PName
pn))
                Name
n   <- (Supply -> (Name, Supply)) -> RenameM Name
forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (Ident -> Range -> Supply -> (Name, Supply)
mkParameter (PName -> Ident
getIdent PName
pn) Range
loc)
                NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (PName -> Name -> NamingEnv
singletonT PName
pn Name
n)

  typeEnv (TRecord Rec (Type PName)
fs)      = [Type PName] -> RenameM NamingEnv
bindTypes (((Range, Type PName) -> Type PName)
-> [(Range, Type PName)] -> [Type PName]
forall a b. (a -> b) -> [a] -> [b]
map (Range, Type PName) -> Type PName
forall a b. (a, b) -> b
snd (Rec (Type PName) -> [(Range, Type PName)]
forall a b. RecordMap a b -> [b]
recordElements Rec (Type PName)
fs))
  typeEnv (TTyApp [Named (Type PName)]
fs)       = [Type PName] -> RenameM NamingEnv
bindTypes ((Named (Type PName) -> Type PName)
-> [Named (Type PName)] -> [Type PName]
forall a b. (a -> b) -> [a] -> [b]
map Named (Type PName) -> Type PName
forall a. Named a -> a
value [Named (Type PName)]
fs)
  typeEnv (TTuple [Type PName]
ts)       = [Type PName] -> RenameM NamingEnv
bindTypes [Type PName]
ts
  typeEnv Type PName
TWild             = NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
forall a. Monoid a => a
mempty
  typeEnv (TLocated Type PName
ty Range
loc) = Range -> RenameM NamingEnv -> RenameM NamingEnv
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
loc (Type PName -> RenameM NamingEnv
typeEnv Type PName
ty)
  typeEnv (TParens Type PName
ty)      = Type PName -> RenameM NamingEnv
typeEnv Type PName
ty
  typeEnv (TInfix Type PName
a Located PName
_ Fixity
_ Type PName
b)  = [Type PName] -> RenameM NamingEnv
bindTypes [Type PName
a,Type PName
b]

  bindTypes :: [Type PName] -> RenameM NamingEnv
bindTypes [] = NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
forall a. Monoid a => a
mempty
  bindTypes (Type PName
t:[Type PName]
ts) =
    do NamingEnv
env' <- Type PName -> RenameM NamingEnv
typeEnv Type PName
t
       NamingEnv -> RenameM NamingEnv -> RenameM NamingEnv
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames NamingEnv
env' (RenameM NamingEnv -> RenameM NamingEnv)
-> RenameM NamingEnv -> RenameM NamingEnv
forall a b. (a -> b) -> a -> b
$
         do NamingEnv
res <- [Type PName] -> RenameM NamingEnv
bindTypes [Type PName]
ts
            NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (NamingEnv
env' NamingEnv -> NamingEnv -> NamingEnv
forall a. Monoid a => a -> a -> a
`mappend` NamingEnv
res)


instance Rename Match where
  rename :: Match PName -> RenameM (Match Name)
rename Match PName
m = case Match PName
m of
    Match Pattern PName
p Expr PName
e  ->                  Pattern Name -> Expr Name -> Match Name
forall name. Pattern name -> Expr name -> Match name
Match    (Pattern Name -> Expr Name -> Match Name)
-> RenameM (Pattern Name) -> RenameM (Expr Name -> Match Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Pattern PName
p RenameM (Expr Name -> Match Name)
-> RenameM (Expr Name) -> RenameM (Match Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Expr PName
e
    MatchLet Bind PName
b -> Bind PName -> RenameM (Match Name) -> RenameM (Match Name)
forall env a.
BindsNames (InModule env) =>
env -> RenameM a -> RenameM a
shadowNamesNS Bind PName
b (Bind Name -> Match Name
forall name. Bind name -> Match name
MatchLet (Bind Name -> Match Name)
-> RenameM (Bind Name) -> RenameM (Match Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bind PName -> RenameM (Bind Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Bind PName
b)

instance Rename TySyn where
  rename :: TySyn PName -> RenameM (TySyn Name)
rename (TySyn Located PName
n Maybe Fixity
f [TParam PName]
ps Type PName
ty) =
    [TParam PName] -> RenameM (TySyn Name) -> RenameM (TySyn Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames [TParam PName]
ps (RenameM (TySyn Name) -> RenameM (TySyn Name))
-> RenameM (TySyn Name) -> RenameM (TySyn Name)
forall a b. (a -> b) -> a -> b
$ Located Name
-> Maybe Fixity -> [TParam Name] -> Type Name -> TySyn Name
forall n.
Located n -> Maybe Fixity -> [TParam n] -> Type n -> TySyn n
TySyn (Located Name
 -> Maybe Fixity -> [TParam Name] -> Type Name -> TySyn Name)
-> RenameM (Located Name)
-> RenameM
     (Maybe Fixity -> [TParam Name] -> Type Name -> TySyn Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated PName -> RenameM Name
renameType Located PName
n
                           RenameM (Maybe Fixity -> [TParam Name] -> Type Name -> TySyn Name)
-> RenameM (Maybe Fixity)
-> RenameM ([TParam Name] -> Type Name -> TySyn Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Fixity -> RenameM (Maybe Fixity)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Fixity
f
                           RenameM ([TParam Name] -> Type Name -> TySyn Name)
-> RenameM [TParam Name] -> RenameM (Type Name -> TySyn Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TParam PName -> RenameM (TParam Name))
-> [TParam PName] -> RenameM [TParam Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TParam PName -> RenameM (TParam Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TParam PName]
ps
                           RenameM (Type Name -> TySyn Name)
-> RenameM (Type Name) -> RenameM (TySyn Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename Type PName
ty

instance Rename PropSyn where
  rename :: PropSyn PName -> RenameM (PropSyn Name)
rename (PropSyn Located PName
n Maybe Fixity
f [TParam PName]
ps [Prop PName]
cs) =
    [TParam PName] -> RenameM (PropSyn Name) -> RenameM (PropSyn Name)
forall env a. BindsNames env => env -> RenameM a -> RenameM a
shadowNames [TParam PName]
ps (RenameM (PropSyn Name) -> RenameM (PropSyn Name))
-> RenameM (PropSyn Name) -> RenameM (PropSyn Name)
forall a b. (a -> b) -> a -> b
$ Located Name
-> Maybe Fixity -> [TParam Name] -> [Prop Name] -> PropSyn Name
forall n.
Located n -> Maybe Fixity -> [TParam n] -> [Prop n] -> PropSyn n
PropSyn (Located Name
 -> Maybe Fixity -> [TParam Name] -> [Prop Name] -> PropSyn Name)
-> RenameM (Located Name)
-> RenameM
     (Maybe Fixity -> [TParam Name] -> [Prop Name] -> PropSyn Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PName -> RenameM Name) -> Located PName -> RenameM (Located Name)
forall a b. (a -> RenameM b) -> Located a -> RenameM (Located b)
rnLocated PName -> RenameM Name
renameType Located PName
n
                             RenameM
  (Maybe Fixity -> [TParam Name] -> [Prop Name] -> PropSyn Name)
-> RenameM (Maybe Fixity)
-> RenameM ([TParam Name] -> [Prop Name] -> PropSyn Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Fixity -> RenameM (Maybe Fixity)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Fixity
f
                             RenameM ([TParam Name] -> [Prop Name] -> PropSyn Name)
-> RenameM [TParam Name] -> RenameM ([Prop Name] -> PropSyn Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TParam PName -> RenameM (TParam Name))
-> [TParam PName] -> RenameM [TParam Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TParam PName -> RenameM (TParam Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [TParam PName]
ps
                             RenameM ([Prop Name] -> PropSyn Name)
-> RenameM [Prop Name] -> RenameM (PropSyn Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Prop PName -> RenameM (Prop Name))
-> [Prop PName] -> RenameM [Prop Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Prop PName -> RenameM (Prop Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename [Prop PName]
cs


-- Utilities -------------------------------------------------------------------

rnNamed :: (a -> RenameM b) -> Named a -> RenameM (Named b)
rnNamed :: (a -> RenameM b) -> Named a -> RenameM (Named b)
rnNamed  = (a -> RenameM b) -> Named a -> RenameM (Named b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
{-# INLINE rnNamed #-}