-- |
-- 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 Data.List(find)
import Data.Maybe (fromMaybe)
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 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 _ e :: RenamerError
e = case RenamerError
e of

    MultipleSyms lqn :: Located PName
lqn qns :: [Name]
qns disp :: 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 "[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))
         4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc
text "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 lqn :: Located PName
lqn disp :: 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 "[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))
         4 (String -> Doc
text "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 lqn :: Located PName
lqn disp :: 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 "[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))
         4 (String -> Doc
text "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 qns :: [Name]
qns disp :: 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 "[error]")
         4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "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 lqn :: Located PName
lqn disp :: 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 "[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))
         4 ([Doc] -> Doc
fsep [ String -> Doc
text "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 "but found a type instead"
                 , String -> Doc
text "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
text")?" ])

    ExpectedType lqn :: Located PName
lqn disp :: 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 "[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))
         4 ([Doc] -> Doc
fsep [ String -> Doc
text "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 "but found a value instead" ])

    FixityError o1 :: Located Name
o1 f1 :: Fixity
f1 o2 :: Located Name
o2 f2 :: Fixity
f2 disp :: 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 "[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 "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))
         4 ([Doc] -> Doc
fsep [ String -> Doc
text "The fixities of"
                 , Int -> Doc -> Doc
nest 2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
                   [ "•" 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
<+> 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 "are not compatible."
                 , String -> Doc
text "You may use explicit parentheses to disambiguate." ])

    InvalidConstraint ty :: Type PName
ty disp :: 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 "[error]" Doc -> Doc -> Doc
<+> Doc -> (Range -> Doc) -> Maybe Range -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\r :: Range
r -> String -> Doc
text "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))
         4 ([Doc] -> Doc
fsep [ Type PName -> Doc
forall a. PP a => a -> Doc
pp Type PName
ty, String -> Doc
text "is not a valid constraint" ])

    MalformedBuiltin ty :: Type PName
ty pn :: PName
pn disp :: 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 "[error]" Doc -> Doc -> Doc
<+> Doc -> (Range -> Doc) -> Maybe Range -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\r :: Range
r -> String -> Doc
text "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))
         4 ([Doc] -> Doc
fsep [ String -> Doc
text "invalid use of built-in type", PName -> Doc
forall a. PP a => a -> Doc
pp PName
pn
                 , String -> Doc
text "in type", Type PName -> Doc
forall a. PP a => a -> Doc
pp Type PName
ty ])

    BoundReservedType n :: PName
n loc :: Maybe Range
loc src :: Doc
src disp :: 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 "[error]" Doc -> Doc -> Doc
<+> Doc -> (Range -> Doc) -> Maybe Range -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\r :: Range
r -> String -> Doc
text "at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp Range
r) Maybe Range
loc)
         4 ([Doc] -> Doc
fsep [ String -> Doc
text "built-in type", Doc -> Doc
quotes (PName -> Doc
forall a. PP a => a -> Doc
pp PName
n), String -> Doc
text "shadowed in", Doc
src ])

    OverlappingRecordUpdate xs :: Located [Selector]
xs ys :: Located [Selector]
ys disp :: NameDisp
disp -> NameDisp -> Doc -> Doc
fixNameDisp NameDisp
disp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      Doc -> Int -> Doc -> Doc
hang "[error] Overlapping record updates:"
         4 ([Doc] -> Doc
vcat [ Located [Selector] -> Doc
ppLab Located [Selector]
xs, Located [Selector] -> Doc
ppLab Located [Selector]
ys ])
      where
      ppLab :: Located [Selector] -> Doc
ppLab as :: Located [Selector]
as = [Selector] -> Doc
ppNestedSels (Located [Selector] -> [Selector]
forall a. Located a -> a
thing Located [Selector]
as) 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 _ (SymbolShadowed new :: Name
new originals :: [Name]
originals disp :: 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 "[warning] at" Doc -> Doc -> Doc
<+> Doc
loc)
       4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep [ String -> Doc
text "This binding for" Doc -> Doc -> Doc
<+> Doc -> Doc
backticks Doc
sym
                , String -> Doc
text "shadows the existing binding" Doc -> Doc -> Doc
<.> Doc
plural Doc -> Doc -> Doc
<+>
                  String -> Doc
text "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
> 1 = Char -> Doc
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 _ (UnusedName x :: Name
x disp :: 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 "[warning] at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Name -> Range
nameLoc Name
x))
       4 (String -> Doc
text "Unused name:" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. PP a => a -> Doc
pp Name
x)

-- 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 -> Seq RenamerWarning
rwWarnings      :: !(Seq.Seq RenamerWarning)
  , 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 (<>) #-}
  a :: RenameM a
a <> :: RenameM a -> RenameM a -> RenameM a
<> b :: 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 f :: a -> b
f m :: 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 x :: 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 (<*>) #-}
  l :: RenameM (a -> b)
l <*> :: RenameM (a -> b) -> RenameM a -> RenameM b
<*> r :: 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 x :: 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 (>>=) #-}
  m :: RenameM a
m >>= :: RenameM a -> (a -> RenameM b) -> RenameM b
>>= k :: 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 f :: 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 { .. } ->
    let (a :: a
a,s' :: Supply
s') = Supply -> (a, Supply)
f Supply
rwSupply
        rw' :: RW
rw'    = $WRW :: Seq RenamerWarning
-> Seq RenamerError -> Supply -> Map Name Int -> RW
RW { rwSupply :: Supply
rwSupply = Supply
s', .. }
     in a
a a -> (a, RW) -> (a, RW)
forall a b. a -> b -> b
`seq` RW
rw' RW -> (a, RW) -> (a, RW)
forall a b. a -> b -> b
`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 s :: Supply
s ns :: ModName
ns env :: NamingEnv
env m :: RenameM a
m = (Either [RenamerError] (a, Supply)
res, ModName -> NamingEnv -> RO -> RW -> [RenamerWarning]
warnUnused ModName
ns NamingEnv
env RO
ro RW
rw [RenamerWarning] -> [RenamerWarning] -> [RenamerWarning]
forall a. [a] -> [a] -> [a]
++ Seq RenamerWarning -> [RenamerWarning]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (RW -> Seq RenamerWarning
rwWarnings RW
rw))
  where
  (a :: a
a,rw :: 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
                              $WRW :: Seq RenamerWarning
-> Seq RenamerError -> Supply -> Map Name Int -> RW
RW { rwErrors :: Seq RenamerError
rwErrors   = Seq RenamerError
forall a. Seq a
Seq.empty
                                 , rwWarnings :: Seq RenamerWarning
rwWarnings = Seq RenamerWarning
forall a. Seq a
Seq.empty
                                 , rwSupply :: Supply
rwSupply   = Supply
s
                                 , rwNameUseCount :: Map Name Int
rwNameUseCount = Map Name Int
forall k a. Map k a
Map.empty
                                 }

  ro :: RO
ro = $WRO :: 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 f :: 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 { .. } <- ReaderT RO (StateT RW Lift) RO
forall (m :: * -> *) i. ReaderM m i => m i
ask
     RW { .. } <- 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 $WRW :: Seq RenamerWarning
-> 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, .. }

-- | 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 thing :: a
thing =
  do Range
srcRange <- RenameM Range
curLoc
     Located a -> RenameM (Located a)
forall (m :: * -> *) a. Monad m => a -> m a
return $WLocated :: forall a. Range -> a -> Located a
Located { .. }

-- | 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
loc m :: 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
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)

  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. The boolean
-- parameter indicates whether or not to check for shadowing.
shadowNames' :: BindsNames env => EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' :: EnvCheck -> env -> RenameM a -> RenameM a
shadowNames' check :: EnvCheck
check names :: env
names m :: 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 names :: env
names m :: 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 disp :: NameDisp
disp check :: EnvCheck
check l :: NamingEnv
l r :: NamingEnv
r rw :: 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
rw',es :: 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
rw'',ts :: 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 prj :: NamingEnv -> Map k [Name]
prj acc :: RW
acc k :: k
k ns :: [Name]
ns = (RW
acc', [[Name] -> Name
forall a. [a] -> a
head [Name]
ns])
    where
    acc' :: RW
acc' = RW
acc
      { rwWarnings :: Seq RenamerWarning
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
                    Nothing -> RW -> Seq RenamerWarning
rwWarnings RW
acc
                    Just os :: [Name]
os -> RW -> Seq RenamerWarning
rwWarnings RW
acc Seq RenamerWarning -> RenamerWarning -> Seq RenamerWarning
forall a. Seq a -> a -> Seq a
Seq.|> Name -> [Name] -> NameDisp -> RenamerWarning
SymbolShadowed ([Name] -> Name
forall a. [a] -> a
head [Name]
ns) [Name]
os NameDisp
disp

             else RW -> Seq RenamerWarning
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 _    [_] = Seq RenamerError
forall a. Seq a
Seq.empty
containsOverlap _    []  = String -> [String] -> Seq RenamerError
forall a. HasCallStack => String -> [String] -> a
panic "Renamer" ["Invalid naming environment"]
containsOverlap disp :: NameDisp
disp ns :: [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 env :: 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 ns :: [Name]
ns acc :: 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 x :: 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
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 1 (RW -> Map Name Int
rwNameUseCount RW
rw) }


warnUnused :: ModName -> NamingEnv -> RO -> RW -> [RenamerWarning]
warnUnused :: ModName -> NamingEnv -> RO -> RW -> [RenamerWarning]
warnUnused m0 :: ModName
m0 env :: NamingEnv
env ro :: RO
ro rw :: 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 x :: Name
x   = Name -> NameDisp -> RenamerWarning
UnusedName Name
x (RO -> NameDisp
roDisp RO
ro)
  keep :: Name -> a -> Bool
keep k :: Name
k n :: a
n = a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 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 nm :: Name
nm = case Name -> NameInfo
nameInfo Name
nm of
                 Declared m :: ModName
m sys :: 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
                 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 m :: 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 td :: TopDecl PName
td     = case TopDecl PName
td of
    Decl d :: 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 d :: 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 n :: 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 n :: 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 f :: 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 f :: 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 d :: [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 x :: 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 pt :: 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 (as :: [TParam PName]
as,ps :: [Prop PName]
ps) = PrimType PName -> ([TParam PName], [Prop PName])
forall name. PrimType name -> ([TParam name], [Prop name])
primTCts PrimType PName
pt
       (_,cts :: ([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
$ \as' :: [TParam Name]
as' ps' :: [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 a :: 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 a :: 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 f :: a -> RenameM b
f loc :: 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 d :: Decl PName
d      = case Decl PName
d of
    DSignature ns :: [Located PName]
ns sig :: 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 ns :: [Located PName]
ns p :: 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 b :: 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 pat :: Pattern PName
pat e :: Expr PName
e    -> do (pe :: NamingEnv
pe,pat' :: 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 syn :: 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 syn :: 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 d' :: Decl PName
d' r :: 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 "Renamer" ["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 n :: 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 qn :: 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 [n :: 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 "Renamer" ["Invalid expression renaming environment"]
    Just syms :: [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.
    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 _ -> (NameDisp -> RenamerError) -> RenameM ()
record (Located PName -> NameDisp -> RenamerError
ExpectedValue Located PName
n)

           -- the value is just missing
           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 pn :: 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 [n :: 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 "Renamer" ["Invalid type renaming environment"]
       Just syms :: [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))
       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 pn :: PName
pn =
  do Maybe Name
mb <- PName -> RenameM (Maybe Name)
typeExists PName
pn
     case Maybe Name
mb of
       Just n :: 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.
       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 = $WLocated :: 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 _ -> (NameDisp -> RenamerError) -> RenameM ()
record (Located PName -> NameDisp -> RenamerError
ExpectedType Located PName
n)

              -- no terms with the same name, so the type is just unbound
              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 pn :: 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 s :: 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 ps :: [TParam PName]
ps p :: [Prop PName]
p ty :: Type PName
ty loc :: 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
$ \ps' :: [TParam Name]
ps' p' :: [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 as :: [TParam PName]
as ps :: [Prop PName]
ps k :: [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 { .. } =
    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, .. }

instance Rename Prop where
  rename :: Prop PName -> RenameM (Prop Name)
rename (CType t :: 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


-- | Resolve fixity, then rename the resulting type.
instance Rename Type where
  rename :: Type PName -> RenameM (Type Name)
rename ty0 :: Type PName
ty0 = Type PName -> RenameM (Type Name)
go (Type PName -> RenameM (Type Name))
-> RenameM (Type PName) -> RenameM (Type Name)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type PName -> RenameM (Type PName)
resolveTypeFixity Type PName
ty0
    where
    go :: Type PName -> RenameM (Type Name)
    go :: Type PName -> RenameM (Type Name)
go (TFun a :: Type PName
a b :: 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)
go 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)
go Type PName
b
    go (TSeq n :: Type PName
n a :: 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)
go 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)
go Type PName
a
    go  TBit         = Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Type Name
forall n. Type n
TBit
    go (TNum c :: 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)
    go (TChar c :: 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)

    go (TUser qn :: PName
qn ps :: [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)
go [Type PName]
ps
    go (TRecord fs :: [Named (Type PName)]
fs)    = [Named (Type Name)] -> Type Name
forall n. [Named (Type n)] -> Type n
TRecord  ([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 a b. (a -> RenameM b) -> Named a -> RenameM (Named b)
rnNamed Type PName -> RenameM (Type Name)
go) [Named (Type PName)]
fs
    go (TTuple fs :: [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)
go [Type PName]
fs
    go  TWild          = Type Name -> RenameM (Type Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Type Name
forall n. Type n
TWild
    go (TLocated t' :: Type PName
t' r :: 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)
go 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)

    go (TParens t' :: 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)
go Type PName
t'

    -- at this point, the fixity is correct, and we just need to perform
    -- renaming.
    go (TInfix a :: Type PName
a o :: Located PName
o f :: Fixity
f b :: Type PName
b) = Type Name -> Located Name -> Fixity -> Type Name -> Type Name
forall n. Type n -> Located n -> Fixity -> Type n -> Type n
TInfix (Type Name -> Located Name -> Fixity -> Type Name -> Type Name)
-> RenameM (Type Name)
-> RenameM (Located Name -> Fixity -> 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 (Located Name -> Fixity -> Type Name -> Type Name)
-> RenameM (Located Name)
-> RenameM (Fixity -> Type Name -> Type Name)
forall (f :: * -> *) a b. Applicative f => 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
o
                                 RenameM (Fixity -> Type Name -> Type Name)
-> RenameM Fixity -> RenameM (Type Name -> Type Name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fixity -> RenameM Fixity
forall (f :: * -> *) a. Applicative f => a -> f a
pure Fixity
f
                                 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


resolveTypeFixity :: Type PName -> RenameM (Type PName)
resolveTypeFixity :: Type PName -> RenameM (Type PName)
resolveTypeFixity  = Type PName -> RenameM (Type PName)
go
  where
  go :: Type PName -> RenameM (Type PName)
go t :: Type PName
t = case Type PName
t of
    TFun a :: Type PName
a b :: Type PName
b     -> Type PName -> Type PName -> Type PName
forall n. Type n -> Type n -> Type n
TFun     (Type PName -> Type PName -> Type PName)
-> RenameM (Type PName) -> RenameM (Type PName -> Type PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type PName)
go Type PName
a  RenameM (Type PName -> Type PName)
-> RenameM (Type PName) -> RenameM (Type PName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type PName)
go Type PName
b
    TSeq n :: Type PName
n a :: Type PName
a     -> Type PName -> Type PName -> Type PName
forall n. Type n -> Type n -> Type n
TSeq     (Type PName -> Type PName -> Type PName)
-> RenameM (Type PName) -> RenameM (Type PName -> Type PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type PName)
go Type PName
n  RenameM (Type PName -> Type PName)
-> RenameM (Type PName) -> RenameM (Type PName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> RenameM (Type PName)
go Type PName
a
    TUser pn :: PName
pn ps :: [Type PName]
ps  -> PName -> [Type PName] -> Type PName
forall n. n -> [Type n] -> Type n
TUser PName
pn ([Type PName] -> Type PName)
-> RenameM [Type PName] -> RenameM (Type PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type PName -> RenameM (Type PName))
-> [Type PName] -> RenameM [Type PName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type PName)
go [Type PName]
ps
    TRecord fs :: [Named (Type PName)]
fs   -> [Named (Type PName)] -> Type PName
forall n. [Named (Type n)] -> Type n
TRecord  ([Named (Type PName)] -> Type PName)
-> RenameM [Named (Type PName)] -> RenameM (Type PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Named (Type PName) -> RenameM (Named (Type PName)))
-> [Named (Type PName)] -> RenameM [Named (Type PName)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Type PName -> RenameM (Type PName))
-> Named (Type PName) -> RenameM (Named (Type PName))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type PName)
go) [Named (Type PName)]
fs
    TTuple fs :: [Type PName]
fs    -> [Type PName] -> Type PName
forall n. [Type n] -> Type n
TTuple   ([Type PName] -> Type PName)
-> RenameM [Type PName] -> RenameM (Type PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type PName -> RenameM (Type PName))
-> [Type PName] -> RenameM [Type PName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Type PName -> RenameM (Type PName)
go [Type PName]
fs

    TLocated t' :: Type PName
t' r :: Range
r-> Range -> RenameM (Type PName) -> RenameM (Type PName)
forall loc a. HasLoc loc => loc -> RenameM a -> RenameM a
withLoc Range
r (Type PName -> Range -> Type PName
forall n. Type n -> Range -> Type n
TLocated (Type PName -> Range -> Type PName)
-> RenameM (Type PName) -> RenameM (Range -> Type PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type PName)
go Type PName
t' RenameM (Range -> Type PName)
-> RenameM Range -> RenameM (Type PName)
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 t' :: Type PName
t'   -> Type PName -> Type PName
forall n. Type n -> Type n
TParens (Type PName -> Type PName)
-> RenameM (Type PName) -> RenameM (Type PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type PName -> RenameM (Type PName)
go Type PName
t'

    TInfix a :: Type PName
a o :: Located PName
o _ b :: Type PName
b ->
      do (Type PName -> Type PName -> Type PName, Fixity)
op <- Located PName
-> RenameM (Type PName -> Type PName -> Type PName, Fixity)
lookupFixity Located PName
o
         Type PName
a' <- Type PName -> RenameM (Type PName)
go Type PName
a
         Type PName
b' <- Type PName -> RenameM (Type PName)
go Type PName
b
         Type PName
-> (Type PName -> Type PName -> Type PName, Fixity)
-> Type PName
-> RenameM (Type PName)
mkTInfix Type PName
a' (Type PName -> Type PName -> Type PName, Fixity)
op Type PName
b'

    TBit         -> Type PName -> RenameM (Type PName)
forall (m :: * -> *) a. Monad m => a -> m a
return Type PName
t
    TNum _       -> Type PName -> RenameM (Type PName)
forall (m :: * -> *) a. Monad m => a -> m a
return Type PName
t
    TChar _      -> Type PName -> RenameM (Type PName)
forall (m :: * -> *) a. Monad m => a -> m a
return Type PName
t
    TWild        -> Type PName -> RenameM (Type PName)
forall (m :: * -> *) a. Monad m => a -> m a
return Type PName
t


type TOp = Type PName -> Type PName -> Type PName

mkTInfix :: Type PName -> (TOp,Fixity) -> Type PName -> RenameM (Type PName)

mkTInfix :: Type PName
-> (Type PName -> Type PName -> Type PName, Fixity)
-> Type PName
-> RenameM (Type PName)
mkTInfix t :: Type PName
t op :: (Type PName -> Type PName -> Type PName, Fixity)
op@(o2 :: Type PName -> Type PName -> Type PName
o2,f2 :: Fixity
f2) z :: Type PName
z =
  case Type PName
t of
    TLocated t1 :: Type PName
t1 _ -> Type PName
-> (Type PName -> Type PName -> Type PName, Fixity)
-> Type PName
-> RenameM (Type PName)
mkTInfix Type PName
t1 (Type PName -> Type PName -> Type PName, Fixity)
op Type PName
z
    TInfix x :: Type PName
x ln :: Located PName
ln f1 :: Fixity
f1 y :: Type PName
y ->
      (Type PName -> Type PName -> Type PName)
-> Fixity -> Type PName -> Type PName -> RenameM (Type PName)
forall t.
(t -> Type PName -> Type PName)
-> Fixity -> t -> Type PName -> RenameM (Type PName)
doFixity (\a :: Type PName
a b :: Type PName
b -> Type PName -> Located PName -> Fixity -> Type PName -> Type PName
forall n. Type n -> Located n -> Fixity -> Type n -> Type n
TInfix Type PName
a Located PName
ln Fixity
f1 Type PName
b) Fixity
f1 Type PName
x Type PName
y

    _ -> Type PName -> RenameM (Type PName)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type PName -> Type PName -> Type PName
o2 Type PName
t Type PName
z)

  where
  doFixity :: (t -> Type PName -> Type PName)
-> Fixity -> t -> Type PName -> RenameM (Type PName)
doFixity mk :: t -> Type PName -> Type PName
mk f1 :: Fixity
f1 x :: t
x y :: Type PName
y =
    case Fixity -> Fixity -> FixityCmp
compareFixity Fixity
f1 Fixity
f2 of
      FCLeft  -> Type PName -> RenameM (Type PName)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type PName -> Type PName -> Type PName
o2 Type PName
t Type PName
z)
      FCRight -> do Type PName
r <- Type PName
-> (Type PName -> Type PName -> Type PName, Fixity)
-> Type PName
-> RenameM (Type PName)
mkTInfix Type PName
y (Type PName -> Type PName -> Type PName, Fixity)
op Type PName
z
                    Type PName -> RenameM (Type PName)
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> Type PName -> Type PName
mk t
x Type PName
r)

      -- As the fixity table is known, and this is a case where the fixity came
      -- from that table, it's a real error if the fixities didn't work out.
      FCError -> String -> [String] -> RenameM (Type PName)
forall a. HasCallStack => String -> [String] -> a
panic "Renamer" [ "fixity problem for type operators"
                                 , Type PName -> String
forall a. Show a => a -> String
show (Type PName -> Type PName -> Type PName
o2 Type PName
t Type PName
z) ]



-- | When possible, rewrite the type operator to a known constructor, otherwise
-- return a 'TOp' that reconstructs the original term, and a default fixity.
lookupFixity :: Located PName -> RenameM (TOp, Fixity)
lookupFixity :: Located PName
-> RenameM (Type PName -> Type PName -> Type PName, Fixity)
lookupFixity op :: Located PName
op =
  do Name
n <- PName -> RenameM Name
renameType PName
sym
     let fi :: Fixity
fi = Fixity -> Maybe Fixity -> Fixity
forall a. a -> Maybe a -> a
fromMaybe Fixity
defaultFixity (Name -> Maybe Fixity
nameFixity Name
n)
     (Type PName -> Type PName -> Type PName, Fixity)
-> RenameM (Type PName -> Type PName -> Type PName, Fixity)
forall (m :: * -> *) a. Monad m => a -> m a
return (\x :: Type PName
x y :: Type PName
y -> Type PName -> Located PName -> Fixity -> Type PName -> Type PName
forall n. Type n -> Located n -> Fixity -> Type n -> Type n
TInfix Type PName
x Located PName
op Fixity
fi Type PName
y, Fixity
fi)

  where
  sym :: PName
sym = Located PName -> PName
forall a. Located a -> a
thing Located PName
op


-- | Rename a binding.
instance Rename Bind where
  rename :: Bind PName -> RenameM (Bind Name)
rename b :: 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 (patEnv :: NamingEnv
patEnv,pats' :: [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 DPrim     = BindDef Name -> RenameM (BindDef Name)
forall (m :: * -> *) a. Monad m => a -> m a
return BindDef Name
forall name. BindDef name
DPrim
  rename (DExpr e :: 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 p :: Pattern PName
p      = case Pattern PName
p of
    PVar lv :: 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
    PWild           -> Pattern Name -> RenameM (Pattern Name)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern Name
forall n. Pattern n
PWild
    PTuple ps :: [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 nps :: [Named (Pattern PName)]
nps     -> [Named (Pattern Name)] -> Pattern Name
forall n. [Named (Pattern n)] -> Pattern n
PRecord  ([Named (Pattern Name)] -> Pattern Name)
-> RenameM [Named (Pattern Name)] -> RenameM (Pattern Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Named (Pattern PName) -> RenameM (Named (Pattern Name)))
-> [Named (Pattern PName)] -> RenameM [Named (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))
-> Named (Pattern PName) -> RenameM (Named (Pattern Name))
forall a b. (a -> RenameM b) -> Named a -> RenameM (Named b)
rnNamed Pattern PName -> RenameM (Pattern Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) [Named (Pattern PName)]
nps
    PList elems :: [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 p' :: Pattern PName
p' t :: 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 l :: Pattern PName
l r :: 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 p' :: Pattern PName
p' loc :: 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 h :: UpdHow
h ls :: [Located Selector]
ls e :: 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
      l :: Located Selector
l : more :: [Located Selector]
more ->
       case [Located Selector]
more of
         [] -> case UpdHow
h of
                 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
                 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
         _ -> 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 "rename@UpdField" [ "Empty label list." ]


instance Rename Expr where
  rename :: Expr PName -> RenameM (Expr Name)
rename expr :: Expr PName
expr = case Expr PName
expr of
    EVar n :: 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 l :: 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 e :: 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 e :: 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 e :: 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 es :: [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 fs :: [Named (Expr PName)]
fs      -> [Named (Expr Name)] -> Expr Name
forall n. [Named (Expr n)] -> Expr n
ERecord ([Named (Expr Name)] -> Expr Name)
-> RenameM [Named (Expr Name)] -> RenameM (Expr Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Named (Expr PName) -> RenameM (Named (Expr Name)))
-> [Named (Expr PName)] -> RenameM [Named (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))
-> Named (Expr PName) -> RenameM (Named (Expr Name))
forall a b. (a -> RenameM b) -> Named a -> RenameM (Named b)
rnNamed Expr PName -> RenameM (Expr Name)
forall (f :: * -> *). Rename f => f PName -> RenameM (f Name)
rename) [Named (Expr PName)]
fs
    ESel e' :: Expr PName
e' s :: 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 mb :: Maybe (Expr PName)
mb fs :: [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 es :: [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 s :: Type PName
s n :: Maybe (Type PName)
n e :: Type PName
e t :: 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 a :: Expr PName
a b :: 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 e' :: Expr PName
e' bs :: [[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 (envs :: [NamingEnv]
envs,bs' :: [[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 f :: Expr PName
f x :: 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 f :: Expr PName
f ti :: [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 b :: Expr PName
b t :: Expr PName
t f :: 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 e' :: Expr PName
e' ds :: [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 e' :: Expr PName
e' ty :: 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 ty :: 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 ps :: [Pattern PName]
ps e' :: Expr PName
e'      -> do (env :: NamingEnv
env,ps' :: [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 e' :: Expr PName
e' r :: 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 e :: 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 p :: 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 x :: Expr PName
x y :: Located PName
y _ z :: 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 _ ls :: [Located Selector]
ls _) = [Located Selector]
ls

  check :: [[Located Selector]]
-> [Located Selector] -> RenameM [[Located Selector]]
check done :: [[Located Selector]]
done l :: [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 l' :: [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'))
         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 xs :: [Located Selector]
xs ys :: [Located Selector]
ys =
    case ([Located Selector]
xs,[Located Selector]
ys) of
      ([],_)  -> Bool
True
      (_, []) -> Bool
True
      (x :: Located Selector
x : xs' :: [Located Selector]
xs', y :: Located Selector
y : ys' :: [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 x :: Located Selector
x y :: 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 a :: Int
a _, TupleSel b :: Int
b _)   -> Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b
      (ListSel  a :: Int
a _, ListSel  b :: Int
b _)   -> Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b
      (RecordSel a :: Ident
a _, RecordSel b :: Ident
b _) -> Ident
a Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
b
      _                              -> Bool
False

  reLoc :: [Located b] -> Located [b]
reLoc xs :: [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 x :: Expr Name
x o1 :: Located Name
o1 f1 :: Fixity
f1 y :: Expr Name
y) op :: (Located Name, Fixity)
op@(o2 :: Located Name
o2,f2 :: Fixity
f2) z :: Expr Name
z =
   case Fixity -> Fixity -> FixityCmp
compareFixity Fixity
f1 Fixity
f2 of
     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)

     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)

     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 e' :: Expr Name
e' _) op :: (Located Name, Fixity)
op z :: 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 e :: Expr Name
e (o :: Located Name
o,f :: Fixity
f) z :: 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 ln :: 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)
     case Name -> Maybe Fixity
nameFixity Name
n of
       Just fixity :: Fixity
fixity -> (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)
       Nothing     -> (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
defaultFixity)


instance Rename TypeInst where
  rename :: TypeInst PName -> RenameM (TypeInst Name)
rename ti :: TypeInst PName
ti = case TypeInst PName
ti of
    NamedInst nty :: 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 ty :: 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 (m :: Match PName
m:ms :: [Match PName]
ms) =
  do (me :: NamingEnv
me,m' :: 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 (env :: NamingEnv
env,rest :: [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 p :: Pattern PName
p e :: Expr PName
e) =
  do (pe :: NamingEnv
pe,p' :: 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 b :: 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 p :: 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 ps :: [Pattern PName]
ps = case [Pattern PName]
ps of

    p :: Pattern PName
p:rest :: [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
           (env' :: NamingEnv
env',rest' :: [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 { .. }) =
    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 PWild            = NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
forall a. Monoid a => a
mempty
  go (PTuple ps :: [Pattern PName]
ps)      = [Pattern PName] -> RenameM NamingEnv
bindVars [Pattern PName]
ps
  go (PRecord fs :: [Named (Pattern PName)]
fs)     = [Pattern PName] -> RenameM NamingEnv
bindVars ((Named (Pattern PName) -> Pattern PName)
-> [Named (Pattern PName)] -> [Pattern PName]
forall a b. (a -> b) -> [a] -> [b]
map Named (Pattern PName) -> Pattern PName
forall a. Named a -> a
value [Named (Pattern PName)]
fs)
  go (PList ps :: [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 p :: Pattern PName
p ty :: 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 a :: Pattern PName
a b :: 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 p :: Pattern PName
p loc :: 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 (p :: Pattern PName
p:ps :: [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 a :: Type PName
a b :: Type PName
b) = [Type PName] -> RenameM NamingEnv
bindTypes [Type PName
a,Type PName
b]
  typeEnv (TSeq a :: Type PName
a b :: Type PName
b) = [Type PName] -> RenameM NamingEnv
bindTypes [Type PName
a,Type PName
b]

  typeEnv 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 pn :: PName
pn ps :: [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 _ -> [Type PName] -> RenameM NamingEnv
bindTypes [Type PName]
ps

         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 fs :: [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 ts :: [Type PName]
ts)       = [Type PName] -> RenameM NamingEnv
bindTypes [Type PName]
ts
  typeEnv TWild             = NamingEnv -> RenameM NamingEnv
forall (m :: * -> *) a. Monad m => a -> m a
return NamingEnv
forall a. Monoid a => a
mempty
  typeEnv (TLocated ty :: Type PName
ty loc :: 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 ty :: Type PName
ty)      = Type PName -> RenameM NamingEnv
typeEnv Type PName
ty
  typeEnv (TInfix a :: Type PName
a _ _ b :: 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 (t :: Type PName
t:ts :: [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 m :: Match PName
m = case Match PName
m of
    Match p :: Pattern PName
p e :: 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 b :: 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 n :: Located PName
n f :: Maybe Fixity
f ps :: [TParam PName]
ps ty :: 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 n :: Located PName
n f :: Maybe Fixity
f ps :: [TParam PName]
ps cs :: [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 #-}