{-# LANGUAGE GADTs              #-}

{-| This module defines the notion of a scope and operations on scopes.
-}
module Agda.Syntax.Scope.Base where

import Prelude hiding ( null, length )

import Control.Arrow (first, second, (&&&))
import Control.DeepSeq
import Control.Monad

import Data.Either (partitionEithers)
import Data.Foldable ( length, toList )
import Data.Function
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Maybe
import Data.Semigroup ( Semigroup(..) )

import GHC.Generics (Generic)

import Agda.Benchmarking

import Agda.Syntax.Position
import Agda.Syntax.Common
import Agda.Syntax.Fixity
import Agda.Syntax.Abstract.Name as A
import Agda.Syntax.Concrete.Name as C
import qualified Agda.Syntax.Concrete as C
import Agda.Syntax.Concrete.Fixity as C

import Agda.Utils.AssocList (AssocList)
import qualified Agda.Utils.AssocList as AssocList
import Agda.Utils.Functor
import Agda.Utils.Lens
import Agda.Utils.List
import Agda.Utils.List1 ( List1, pattern (:|) )
import Agda.Utils.List2 ( List2 )
import qualified Agda.Utils.List1 as List1
import qualified Agda.Utils.List2 as List2
import Agda.Utils.Maybe (filterMaybe)
import Agda.Utils.Null
import Agda.Utils.Pretty hiding ((<>))
import qualified Agda.Utils.Pretty as P
import Agda.Utils.Singleton
import qualified Agda.Utils.Map as Map

import Agda.Utils.Impossible

-- * Scope representation

-- | A scope is a named collection of names partitioned into public and private
--   names.
data Scope = Scope
      { Scope -> ModuleName
scopeName           :: A.ModuleName
      , Scope -> [ModuleName]
scopeParents        :: [A.ModuleName]
      , Scope -> ScopeNameSpaces
scopeNameSpaces     :: ScopeNameSpaces
      , Scope -> Map QName ModuleName
scopeImports        :: Map C.QName A.ModuleName
      , Scope -> Maybe DataOrRecordModule
scopeDatatypeModule :: Maybe DataOrRecordModule
      }
  deriving (Scope -> Scope -> Bool
(Scope -> Scope -> Bool) -> (Scope -> Scope -> Bool) -> Eq Scope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
/= :: Scope -> Scope -> Bool
Eq, Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> FilePath
(Int -> Scope -> ShowS)
-> (Scope -> FilePath) -> ([Scope] -> ShowS) -> Show Scope
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scope -> ShowS
showsPrec :: Int -> Scope -> ShowS
$cshow :: Scope -> FilePath
show :: Scope -> FilePath
$cshowList :: [Scope] -> ShowS
showList :: [Scope] -> ShowS
Show, (forall x. Scope -> Rep Scope x)
-> (forall x. Rep Scope x -> Scope) -> Generic Scope
forall x. Rep Scope x -> Scope
forall x. Scope -> Rep Scope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Scope -> Rep Scope x
from :: forall x. Scope -> Rep Scope x
$cto :: forall x. Rep Scope x -> Scope
to :: forall x. Rep Scope x -> Scope
Generic)

data DataOrRecordModule
  = IsDataModule
  | IsRecordModule
  deriving (Int -> DataOrRecordModule -> ShowS
[DataOrRecordModule] -> ShowS
DataOrRecordModule -> FilePath
(Int -> DataOrRecordModule -> ShowS)
-> (DataOrRecordModule -> FilePath)
-> ([DataOrRecordModule] -> ShowS)
-> Show DataOrRecordModule
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DataOrRecordModule -> ShowS
showsPrec :: Int -> DataOrRecordModule -> ShowS
$cshow :: DataOrRecordModule -> FilePath
show :: DataOrRecordModule -> FilePath
$cshowList :: [DataOrRecordModule] -> ShowS
showList :: [DataOrRecordModule] -> ShowS
Show, DataOrRecordModule -> DataOrRecordModule -> Bool
(DataOrRecordModule -> DataOrRecordModule -> Bool)
-> (DataOrRecordModule -> DataOrRecordModule -> Bool)
-> Eq DataOrRecordModule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DataOrRecordModule -> DataOrRecordModule -> Bool
== :: DataOrRecordModule -> DataOrRecordModule -> Bool
$c/= :: DataOrRecordModule -> DataOrRecordModule -> Bool
/= :: DataOrRecordModule -> DataOrRecordModule -> Bool
Eq, Int -> DataOrRecordModule
DataOrRecordModule -> Int
DataOrRecordModule -> [DataOrRecordModule]
DataOrRecordModule -> DataOrRecordModule
DataOrRecordModule -> DataOrRecordModule -> [DataOrRecordModule]
DataOrRecordModule
-> DataOrRecordModule -> DataOrRecordModule -> [DataOrRecordModule]
(DataOrRecordModule -> DataOrRecordModule)
-> (DataOrRecordModule -> DataOrRecordModule)
-> (Int -> DataOrRecordModule)
-> (DataOrRecordModule -> Int)
-> (DataOrRecordModule -> [DataOrRecordModule])
-> (DataOrRecordModule
    -> DataOrRecordModule -> [DataOrRecordModule])
-> (DataOrRecordModule
    -> DataOrRecordModule -> [DataOrRecordModule])
-> (DataOrRecordModule
    -> DataOrRecordModule
    -> DataOrRecordModule
    -> [DataOrRecordModule])
-> Enum DataOrRecordModule
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DataOrRecordModule -> DataOrRecordModule
succ :: DataOrRecordModule -> DataOrRecordModule
$cpred :: DataOrRecordModule -> DataOrRecordModule
pred :: DataOrRecordModule -> DataOrRecordModule
$ctoEnum :: Int -> DataOrRecordModule
toEnum :: Int -> DataOrRecordModule
$cfromEnum :: DataOrRecordModule -> Int
fromEnum :: DataOrRecordModule -> Int
$cenumFrom :: DataOrRecordModule -> [DataOrRecordModule]
enumFrom :: DataOrRecordModule -> [DataOrRecordModule]
$cenumFromThen :: DataOrRecordModule -> DataOrRecordModule -> [DataOrRecordModule]
enumFromThen :: DataOrRecordModule -> DataOrRecordModule -> [DataOrRecordModule]
$cenumFromTo :: DataOrRecordModule -> DataOrRecordModule -> [DataOrRecordModule]
enumFromTo :: DataOrRecordModule -> DataOrRecordModule -> [DataOrRecordModule]
$cenumFromThenTo :: DataOrRecordModule
-> DataOrRecordModule -> DataOrRecordModule -> [DataOrRecordModule]
enumFromThenTo :: DataOrRecordModule
-> DataOrRecordModule -> DataOrRecordModule -> [DataOrRecordModule]
Enum, DataOrRecordModule
DataOrRecordModule
-> DataOrRecordModule -> Bounded DataOrRecordModule
forall a. a -> a -> Bounded a
$cminBound :: DataOrRecordModule
minBound :: DataOrRecordModule
$cmaxBound :: DataOrRecordModule
maxBound :: DataOrRecordModule
Bounded, (forall x. DataOrRecordModule -> Rep DataOrRecordModule x)
-> (forall x. Rep DataOrRecordModule x -> DataOrRecordModule)
-> Generic DataOrRecordModule
forall x. Rep DataOrRecordModule x -> DataOrRecordModule
forall x. DataOrRecordModule -> Rep DataOrRecordModule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DataOrRecordModule -> Rep DataOrRecordModule x
from :: forall x. DataOrRecordModule -> Rep DataOrRecordModule x
$cto :: forall x. Rep DataOrRecordModule x -> DataOrRecordModule
to :: forall x. Rep DataOrRecordModule x -> DataOrRecordModule
Generic)

-- | See 'Agda.Syntax.Common.Access'.
data NameSpaceId
  = PrivateNS        -- ^ Things not exported by this module.
  | PublicNS         -- ^ Things defined and exported by this module.
  | ImportedNS       -- ^ Things from open public, exported by this module.
  deriving (NameSpaceId -> NameSpaceId -> Bool
(NameSpaceId -> NameSpaceId -> Bool)
-> (NameSpaceId -> NameSpaceId -> Bool) -> Eq NameSpaceId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NameSpaceId -> NameSpaceId -> Bool
== :: NameSpaceId -> NameSpaceId -> Bool
$c/= :: NameSpaceId -> NameSpaceId -> Bool
/= :: NameSpaceId -> NameSpaceId -> Bool
Eq, NameSpaceId
NameSpaceId -> NameSpaceId -> Bounded NameSpaceId
forall a. a -> a -> Bounded a
$cminBound :: NameSpaceId
minBound :: NameSpaceId
$cmaxBound :: NameSpaceId
maxBound :: NameSpaceId
Bounded, Int -> NameSpaceId
NameSpaceId -> Int
NameSpaceId -> [NameSpaceId]
NameSpaceId -> NameSpaceId
NameSpaceId -> NameSpaceId -> [NameSpaceId]
NameSpaceId -> NameSpaceId -> NameSpaceId -> [NameSpaceId]
(NameSpaceId -> NameSpaceId)
-> (NameSpaceId -> NameSpaceId)
-> (Int -> NameSpaceId)
-> (NameSpaceId -> Int)
-> (NameSpaceId -> [NameSpaceId])
-> (NameSpaceId -> NameSpaceId -> [NameSpaceId])
-> (NameSpaceId -> NameSpaceId -> [NameSpaceId])
-> (NameSpaceId -> NameSpaceId -> NameSpaceId -> [NameSpaceId])
-> Enum NameSpaceId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: NameSpaceId -> NameSpaceId
succ :: NameSpaceId -> NameSpaceId
$cpred :: NameSpaceId -> NameSpaceId
pred :: NameSpaceId -> NameSpaceId
$ctoEnum :: Int -> NameSpaceId
toEnum :: Int -> NameSpaceId
$cfromEnum :: NameSpaceId -> Int
fromEnum :: NameSpaceId -> Int
$cenumFrom :: NameSpaceId -> [NameSpaceId]
enumFrom :: NameSpaceId -> [NameSpaceId]
$cenumFromThen :: NameSpaceId -> NameSpaceId -> [NameSpaceId]
enumFromThen :: NameSpaceId -> NameSpaceId -> [NameSpaceId]
$cenumFromTo :: NameSpaceId -> NameSpaceId -> [NameSpaceId]
enumFromTo :: NameSpaceId -> NameSpaceId -> [NameSpaceId]
$cenumFromThenTo :: NameSpaceId -> NameSpaceId -> NameSpaceId -> [NameSpaceId]
enumFromThenTo :: NameSpaceId -> NameSpaceId -> NameSpaceId -> [NameSpaceId]
Enum, Int -> NameSpaceId -> ShowS
[NameSpaceId] -> ShowS
NameSpaceId -> FilePath
(Int -> NameSpaceId -> ShowS)
-> (NameSpaceId -> FilePath)
-> ([NameSpaceId] -> ShowS)
-> Show NameSpaceId
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NameSpaceId -> ShowS
showsPrec :: Int -> NameSpaceId -> ShowS
$cshow :: NameSpaceId -> FilePath
show :: NameSpaceId -> FilePath
$cshowList :: [NameSpaceId] -> ShowS
showList :: [NameSpaceId] -> ShowS
Show, (forall x. NameSpaceId -> Rep NameSpaceId x)
-> (forall x. Rep NameSpaceId x -> NameSpaceId)
-> Generic NameSpaceId
forall x. Rep NameSpaceId x -> NameSpaceId
forall x. NameSpaceId -> Rep NameSpaceId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NameSpaceId -> Rep NameSpaceId x
from :: forall x. NameSpaceId -> Rep NameSpaceId x
$cto :: forall x. Rep NameSpaceId x -> NameSpaceId
to :: forall x. Rep NameSpaceId x -> NameSpaceId
Generic)

allNameSpaces :: [NameSpaceId]
allNameSpaces :: [NameSpaceId]
allNameSpaces = [NameSpaceId
forall a. Bounded a => a
minBound..NameSpaceId
forall a. Bounded a => a
maxBound]

type ScopeNameSpaces = [(NameSpaceId, NameSpace)]

localNameSpace :: Access -> NameSpaceId
localNameSpace :: Access -> NameSpaceId
localNameSpace Access
PublicAccess    = NameSpaceId
PublicNS
localNameSpace PrivateAccess{} = NameSpaceId
PrivateNS

nameSpaceAccess :: NameSpaceId -> Access
nameSpaceAccess :: NameSpaceId -> Access
nameSpaceAccess NameSpaceId
PrivateNS = Origin -> Access
PrivateAccess Origin
Inserted
nameSpaceAccess NameSpaceId
_         = Access
PublicAccess

-- | Get a 'NameSpace' from 'Scope'.
scopeNameSpace :: NameSpaceId -> Scope -> NameSpace
scopeNameSpace :: NameSpaceId -> Scope -> NameSpace
scopeNameSpace NameSpaceId
ns = NameSpace -> Maybe NameSpace -> NameSpace
forall a. a -> Maybe a -> a
fromMaybe NameSpace
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe NameSpace -> NameSpace)
-> (Scope -> Maybe NameSpace) -> Scope -> NameSpace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSpaceId -> ScopeNameSpaces -> Maybe NameSpace
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup NameSpaceId
ns (ScopeNameSpaces -> Maybe NameSpace)
-> (Scope -> ScopeNameSpaces) -> Scope -> Maybe NameSpace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope -> ScopeNameSpaces
scopeNameSpaces

-- | A lens for 'scopeNameSpaces'
updateScopeNameSpaces :: (ScopeNameSpaces -> ScopeNameSpaces) -> Scope -> Scope
updateScopeNameSpaces :: (ScopeNameSpaces -> ScopeNameSpaces) -> Scope -> Scope
updateScopeNameSpaces ScopeNameSpaces -> ScopeNameSpaces
f Scope
s = Scope
s { scopeNameSpaces :: ScopeNameSpaces
scopeNameSpaces = ScopeNameSpaces -> ScopeNameSpaces
f (Scope -> ScopeNameSpaces
scopeNameSpaces Scope
s) }

-- | ``Monadic'' lens (Functor sufficient).
updateScopeNameSpacesM ::
  (Functor m) => (ScopeNameSpaces -> m ScopeNameSpaces) -> Scope -> m Scope
updateScopeNameSpacesM :: forall (m :: * -> *).
Functor m =>
(ScopeNameSpaces -> m ScopeNameSpaces) -> Scope -> m Scope
updateScopeNameSpacesM ScopeNameSpaces -> m ScopeNameSpaces
f Scope
s = m ScopeNameSpaces -> (ScopeNameSpaces -> Scope) -> m Scope
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
for (ScopeNameSpaces -> m ScopeNameSpaces
f (ScopeNameSpaces -> m ScopeNameSpaces)
-> ScopeNameSpaces -> m ScopeNameSpaces
forall a b. (a -> b) -> a -> b
$ Scope -> ScopeNameSpaces
scopeNameSpaces Scope
s) ((ScopeNameSpaces -> Scope) -> m Scope)
-> (ScopeNameSpaces -> Scope) -> m Scope
forall a b. (a -> b) -> a -> b
$ \ ScopeNameSpaces
x ->
  Scope
s { scopeNameSpaces :: ScopeNameSpaces
scopeNameSpaces = ScopeNameSpaces
x }

-- | The complete information about the scope at a particular program point
--   includes the scope stack, the local variables, and the context precedence.
data ScopeInfo = ScopeInfo
      { ScopeInfo -> ModuleName
_scopeCurrent       :: A.ModuleName
      , ScopeInfo -> Map ModuleName Scope
_scopeModules       :: Map A.ModuleName Scope
      , ScopeInfo -> LocalVars
_scopeVarsToBind    :: LocalVars     -- ^ The variables that will be bound at the end
                                             --   of the current block of variables (i.e. clause).
                                             --   We collect them here instead of binding them
                                             --   immediately so we can avoid shadowing between
                                             --   variables in the same variable block.
      , ScopeInfo -> LocalVars
_scopeLocals        :: LocalVars
      , ScopeInfo -> PrecedenceStack
_scopePrecedence    :: !PrecedenceStack
      , ScopeInfo -> NameMap
_scopeInverseName   :: NameMap
      , ScopeInfo -> ModuleMap
_scopeInverseModule :: ModuleMap
      , ScopeInfo -> InScopeSet
_scopeInScope       :: InScopeSet
      , ScopeInfo -> Fixities
_scopeFixities      :: C.Fixities    -- ^ Maps concrete names C.Name to fixities
      , ScopeInfo -> Polarities
_scopePolarities    :: C.Polarities  -- ^ Maps concrete names C.Name to polarities
      }
  deriving (Int -> ScopeInfo -> ShowS
[ScopeInfo] -> ShowS
ScopeInfo -> FilePath
(Int -> ScopeInfo -> ShowS)
-> (ScopeInfo -> FilePath)
-> ([ScopeInfo] -> ShowS)
-> Show ScopeInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScopeInfo -> ShowS
showsPrec :: Int -> ScopeInfo -> ShowS
$cshow :: ScopeInfo -> FilePath
show :: ScopeInfo -> FilePath
$cshowList :: [ScopeInfo] -> ShowS
showList :: [ScopeInfo] -> ShowS
Show, (forall x. ScopeInfo -> Rep ScopeInfo x)
-> (forall x. Rep ScopeInfo x -> ScopeInfo) -> Generic ScopeInfo
forall x. Rep ScopeInfo x -> ScopeInfo
forall x. ScopeInfo -> Rep ScopeInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScopeInfo -> Rep ScopeInfo x
from :: forall x. ScopeInfo -> Rep ScopeInfo x
$cto :: forall x. Rep ScopeInfo x -> ScopeInfo
to :: forall x. Rep ScopeInfo x -> ScopeInfo
Generic)

-- | For the sake of highlighting, the '_scopeInverseName' map also stores
--   the 'KindOfName' of an @A.QName@.
data NameMapEntry = NameMapEntry
  { NameMapEntry -> KindOfName
qnameKind     :: KindOfName     -- ^ The 'anameKind'.
  , NameMapEntry -> List1 QName
qnameConcrete :: List1 C.QName  -- ^ Possible renderings of the abstract name.
  }
  deriving (Int -> NameMapEntry -> ShowS
[NameMapEntry] -> ShowS
NameMapEntry -> FilePath
(Int -> NameMapEntry -> ShowS)
-> (NameMapEntry -> FilePath)
-> ([NameMapEntry] -> ShowS)
-> Show NameMapEntry
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NameMapEntry -> ShowS
showsPrec :: Int -> NameMapEntry -> ShowS
$cshow :: NameMapEntry -> FilePath
show :: NameMapEntry -> FilePath
$cshowList :: [NameMapEntry] -> ShowS
showList :: [NameMapEntry] -> ShowS
Show, (forall x. NameMapEntry -> Rep NameMapEntry x)
-> (forall x. Rep NameMapEntry x -> NameMapEntry)
-> Generic NameMapEntry
forall x. Rep NameMapEntry x -> NameMapEntry
forall x. NameMapEntry -> Rep NameMapEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NameMapEntry -> Rep NameMapEntry x
from :: forall x. NameMapEntry -> Rep NameMapEntry x
$cto :: forall x. Rep NameMapEntry x -> NameMapEntry
to :: forall x. Rep NameMapEntry x -> NameMapEntry
Generic)

-- | Invariant: the 'KindOfName' components should be equal
--   whenever we have to concrete renderings of an abstract name.
instance Semigroup NameMapEntry where
  NameMapEntry KindOfName
k List1 QName
xs <> :: NameMapEntry -> NameMapEntry -> NameMapEntry
<> NameMapEntry KindOfName
_ List1 QName
ys = KindOfName -> List1 QName -> NameMapEntry
NameMapEntry KindOfName
k (List1 QName
xs List1 QName -> List1 QName -> List1 QName
forall a. Semigroup a => a -> a -> a
<> List1 QName
ys)

type NameMap   = Map A.QName      NameMapEntry
type ModuleMap = Map A.ModuleName [C.QName]
-- type ModuleMap = Map A.ModuleName (List1 C.QName)

instance Eq ScopeInfo where
  ScopeInfo ModuleName
c1 Map ModuleName Scope
m1 LocalVars
v1 LocalVars
l1 PrecedenceStack
p1 NameMap
_ ModuleMap
_ InScopeSet
_ Fixities
_ Polarities
_ == :: ScopeInfo -> ScopeInfo -> Bool
== ScopeInfo ModuleName
c2 Map ModuleName Scope
m2 LocalVars
v2 LocalVars
l2 PrecedenceStack
p2 NameMap
_ ModuleMap
_ InScopeSet
_ Fixities
_ Polarities
_ =
    ModuleName
c1 ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
c2 Bool -> Bool -> Bool
&& Map ModuleName Scope
m1 Map ModuleName Scope -> Map ModuleName Scope -> Bool
forall a. Eq a => a -> a -> Bool
== Map ModuleName Scope
m2 Bool -> Bool -> Bool
&& LocalVars
v1 LocalVars -> LocalVars -> Bool
forall a. Eq a => a -> a -> Bool
== LocalVars
v2 Bool -> Bool -> Bool
&& LocalVars
l1 LocalVars -> LocalVars -> Bool
forall a. Eq a => a -> a -> Bool
== LocalVars
l2 Bool -> Bool -> Bool
&& PrecedenceStack
p1 PrecedenceStack -> PrecedenceStack -> Bool
forall a. Eq a => a -> a -> Bool
== PrecedenceStack
p2

-- | Local variables.
type LocalVars = AssocList C.Name LocalVar

-- | For each bound variable, we want to know whether it was bound by a
--   λ, Π, module telescope, pattern, or @let@.
data BindingSource
  = LambdaBound  -- ^ @λ@ (currently also used for @Π@ and module parameters)
  | PatternBound -- ^ @f ... =@
  | LetBound     -- ^ @let ... in@
  | WithBound    -- ^ @| ... in q@
  deriving (Int -> BindingSource -> ShowS
[BindingSource] -> ShowS
BindingSource -> FilePath
(Int -> BindingSource -> ShowS)
-> (BindingSource -> FilePath)
-> ([BindingSource] -> ShowS)
-> Show BindingSource
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BindingSource -> ShowS
showsPrec :: Int -> BindingSource -> ShowS
$cshow :: BindingSource -> FilePath
show :: BindingSource -> FilePath
$cshowList :: [BindingSource] -> ShowS
showList :: [BindingSource] -> ShowS
Show, BindingSource -> BindingSource -> Bool
(BindingSource -> BindingSource -> Bool)
-> (BindingSource -> BindingSource -> Bool) -> Eq BindingSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BindingSource -> BindingSource -> Bool
== :: BindingSource -> BindingSource -> Bool
$c/= :: BindingSource -> BindingSource -> Bool
/= :: BindingSource -> BindingSource -> Bool
Eq, (forall x. BindingSource -> Rep BindingSource x)
-> (forall x. Rep BindingSource x -> BindingSource)
-> Generic BindingSource
forall x. Rep BindingSource x -> BindingSource
forall x. BindingSource -> Rep BindingSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BindingSource -> Rep BindingSource x
from :: forall x. BindingSource -> Rep BindingSource x
$cto :: forall x. Rep BindingSource x -> BindingSource
to :: forall x. Rep BindingSource x -> BindingSource
Generic)

instance Pretty BindingSource where
  pretty :: BindingSource -> Doc
pretty = \case
    BindingSource
LambdaBound  -> Doc
"local"
    BindingSource
PatternBound -> Doc
"pattern"
    BindingSource
LetBound     -> Doc
"let-bound"
    BindingSource
WithBound    -> Doc
"with-bound"

-- | A local variable can be shadowed by an import.
--   In case of reference to a shadowed variable, we want to report
--   a scope error.
data LocalVar = LocalVar
  { LocalVar -> Name
localVar           :: A.Name
    -- ^ Unique ID of local variable.
  , LocalVar -> BindingSource
localBindingSource :: BindingSource
    -- ^ Kind of binder used to introduce the variable (@λ@, @let@, ...).
  , LocalVar -> [AbstractName]
localShadowedBy    :: [AbstractName]
     -- ^ If this list is not empty, the local variable is
     --   shadowed by one or more imports.
  }
  deriving (Int -> LocalVar -> ShowS
[LocalVar] -> ShowS
LocalVar -> FilePath
(Int -> LocalVar -> ShowS)
-> (LocalVar -> FilePath) -> ([LocalVar] -> ShowS) -> Show LocalVar
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LocalVar -> ShowS
showsPrec :: Int -> LocalVar -> ShowS
$cshow :: LocalVar -> FilePath
show :: LocalVar -> FilePath
$cshowList :: [LocalVar] -> ShowS
showList :: [LocalVar] -> ShowS
Show, (forall x. LocalVar -> Rep LocalVar x)
-> (forall x. Rep LocalVar x -> LocalVar) -> Generic LocalVar
forall x. Rep LocalVar x -> LocalVar
forall x. LocalVar -> Rep LocalVar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LocalVar -> Rep LocalVar x
from :: forall x. LocalVar -> Rep LocalVar x
$cto :: forall x. Rep LocalVar x -> LocalVar
to :: forall x. Rep LocalVar x -> LocalVar
Generic)

instance Eq LocalVar where
  == :: LocalVar -> LocalVar -> Bool
(==) = Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Name -> Name -> Bool)
-> (LocalVar -> Name) -> LocalVar -> LocalVar -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LocalVar -> Name
localVar

instance Ord LocalVar where
  compare :: LocalVar -> LocalVar -> Ordering
compare = Name -> Name -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Name -> Name -> Ordering)
-> (LocalVar -> Name) -> LocalVar -> LocalVar -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LocalVar -> Name
localVar

-- | We show shadowed variables as prefixed by a ".", as not in scope.
instance Pretty LocalVar where
  pretty :: LocalVar -> Doc
pretty (LocalVar Name
x BindingSource
_ []) = Name -> Doc
forall a. Pretty a => a -> Doc
pretty Name
x
  pretty (LocalVar Name
x BindingSource
_ [AbstractName]
xs) = Doc
"." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
P.<> Name -> Doc
forall a. Pretty a => a -> Doc
pretty Name
x

-- | Shadow a local name by a non-empty list of imports.
shadowLocal :: [AbstractName] -> LocalVar -> LocalVar
shadowLocal :: [AbstractName] -> LocalVar -> LocalVar
shadowLocal [] LocalVar
_ = LocalVar
forall a. HasCallStack => a
__IMPOSSIBLE__
shadowLocal [AbstractName]
ys (LocalVar Name
x BindingSource
b [AbstractName]
zs) = Name -> BindingSource -> [AbstractName] -> LocalVar
LocalVar Name
x BindingSource
b ([AbstractName]
ys [AbstractName] -> [AbstractName] -> [AbstractName]
forall a. [a] -> [a] -> [a]
++ [AbstractName]
zs)

-- | Treat patternBound variable as a module parameter
patternToModuleBound :: LocalVar -> LocalVar
patternToModuleBound :: LocalVar -> LocalVar
patternToModuleBound LocalVar
x
 | LocalVar -> BindingSource
localBindingSource LocalVar
x BindingSource -> BindingSource -> Bool
forall a. Eq a => a -> a -> Bool
== BindingSource
PatternBound =
   LocalVar
x { localBindingSource :: BindingSource
localBindingSource = BindingSource
LambdaBound }
 | Bool
otherwise                     = LocalVar
x

-- | Project name of unshadowed local variable.
notShadowedLocal :: LocalVar -> Maybe A.Name
notShadowedLocal :: LocalVar -> Maybe Name
notShadowedLocal (LocalVar Name
x BindingSource
_ []) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
x
notShadowedLocal LocalVar
_ = Maybe Name
forall a. Maybe a
Nothing

-- | Get all locals that are not shadowed __by imports__.
notShadowedLocals :: LocalVars -> AssocList C.Name A.Name
notShadowedLocals :: LocalVars -> AssocList Name Name
notShadowedLocals = ((Name, LocalVar) -> Maybe (Name, Name))
-> LocalVars -> AssocList Name Name
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (((Name, LocalVar) -> Maybe (Name, Name))
 -> LocalVars -> AssocList Name Name)
-> ((Name, LocalVar) -> Maybe (Name, Name))
-> LocalVars
-> AssocList Name Name
forall a b. (a -> b) -> a -> b
$ \ (Name
c,LocalVar
x) -> (Name
c,) (Name -> (Name, Name)) -> Maybe Name -> Maybe (Name, Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocalVar -> Maybe Name
notShadowedLocal LocalVar
x

-- | Lenses for ScopeInfo components
scopeCurrent :: Lens' A.ModuleName ScopeInfo
scopeCurrent :: Lens' ModuleName ScopeInfo
scopeCurrent ModuleName -> f ModuleName
f ScopeInfo
s =
  ModuleName -> f ModuleName
f (ScopeInfo -> ModuleName
_scopeCurrent ScopeInfo
s) f ModuleName -> (ModuleName -> ScopeInfo) -> f ScopeInfo
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&>
  \ModuleName
x -> ScopeInfo
s { _scopeCurrent :: ModuleName
_scopeCurrent = ModuleName
x }

scopeModules :: Lens' (Map A.ModuleName Scope) ScopeInfo
scopeModules :: Lens' (Map ModuleName Scope) ScopeInfo
scopeModules Map ModuleName Scope -> f (Map ModuleName Scope)
f ScopeInfo
s =
  Map ModuleName Scope -> f (Map ModuleName Scope)
f (ScopeInfo -> Map ModuleName Scope
_scopeModules ScopeInfo
s) f (Map ModuleName Scope)
-> (Map ModuleName Scope -> ScopeInfo) -> f ScopeInfo
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&>
  \Map ModuleName Scope
x -> ScopeInfo
s { _scopeModules :: Map ModuleName Scope
_scopeModules = Map ModuleName Scope
x }

scopeVarsToBind :: Lens' LocalVars ScopeInfo
scopeVarsToBind :: Lens' LocalVars ScopeInfo
scopeVarsToBind LocalVars -> f LocalVars
f ScopeInfo
s =
  LocalVars -> f LocalVars
f (ScopeInfo -> LocalVars
_scopeVarsToBind ScopeInfo
s) f LocalVars -> (LocalVars -> ScopeInfo) -> f ScopeInfo
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&>
  \LocalVars
x -> ScopeInfo
s { _scopeVarsToBind :: LocalVars
_scopeVarsToBind = LocalVars
x }

scopeLocals :: Lens' LocalVars ScopeInfo
scopeLocals :: Lens' LocalVars ScopeInfo
scopeLocals LocalVars -> f LocalVars
f ScopeInfo
s =
  LocalVars -> f LocalVars
f (ScopeInfo -> LocalVars
_scopeLocals ScopeInfo
s) f LocalVars -> (LocalVars -> ScopeInfo) -> f ScopeInfo
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&>
  \LocalVars
x -> ScopeInfo
s { _scopeLocals :: LocalVars
_scopeLocals = LocalVars
x }

scopePrecedence :: Lens' PrecedenceStack ScopeInfo
scopePrecedence :: Lens' PrecedenceStack ScopeInfo
scopePrecedence PrecedenceStack -> f PrecedenceStack
f ScopeInfo
s =
  PrecedenceStack -> f PrecedenceStack
f (ScopeInfo -> PrecedenceStack
_scopePrecedence ScopeInfo
s) f PrecedenceStack -> (PrecedenceStack -> ScopeInfo) -> f ScopeInfo
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&>
  \PrecedenceStack
x -> ScopeInfo
s { _scopePrecedence :: PrecedenceStack
_scopePrecedence = PrecedenceStack
x }

scopeInverseName :: Lens' NameMap ScopeInfo
scopeInverseName :: Lens' NameMap ScopeInfo
scopeInverseName NameMap -> f NameMap
f ScopeInfo
s =
  NameMap -> f NameMap
f (ScopeInfo -> NameMap
_scopeInverseName ScopeInfo
s) f NameMap -> (NameMap -> ScopeInfo) -> f ScopeInfo
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&>
  \NameMap
x -> ScopeInfo
s { _scopeInverseName :: NameMap
_scopeInverseName = NameMap
x }

scopeInverseModule :: Lens' ModuleMap ScopeInfo
scopeInverseModule :: Lens' ModuleMap ScopeInfo
scopeInverseModule ModuleMap -> f ModuleMap
f ScopeInfo
s =
  ModuleMap -> f ModuleMap
f (ScopeInfo -> ModuleMap
_scopeInverseModule ScopeInfo
s) f ModuleMap -> (ModuleMap -> ScopeInfo) -> f ScopeInfo
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&>
  \ModuleMap
x -> ScopeInfo
s { _scopeInverseModule :: ModuleMap
_scopeInverseModule = ModuleMap
x }

scopeInScope :: Lens' InScopeSet ScopeInfo
scopeInScope :: Lens' InScopeSet ScopeInfo
scopeInScope InScopeSet -> f InScopeSet
f ScopeInfo
s =
  InScopeSet -> f InScopeSet
f (ScopeInfo -> InScopeSet
_scopeInScope ScopeInfo
s) f InScopeSet -> (InScopeSet -> ScopeInfo) -> f ScopeInfo
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&>
  \InScopeSet
x -> ScopeInfo
s { _scopeInScope :: InScopeSet
_scopeInScope = InScopeSet
x }

scopeFixities :: Lens' C.Fixities ScopeInfo
scopeFixities :: Lens' Fixities ScopeInfo
scopeFixities Fixities -> f Fixities
f ScopeInfo
s =
  Fixities -> f Fixities
f (ScopeInfo -> Fixities
_scopeFixities ScopeInfo
s) f Fixities -> (Fixities -> ScopeInfo) -> f ScopeInfo
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&>
  \Fixities
x -> ScopeInfo
s { _scopeFixities :: Fixities
_scopeFixities = Fixities
x }

scopePolarities :: Lens' C.Polarities ScopeInfo
scopePolarities :: Lens' Polarities ScopeInfo
scopePolarities Polarities -> f Polarities
f ScopeInfo
s =
  Polarities -> f Polarities
f (ScopeInfo -> Polarities
_scopePolarities ScopeInfo
s) f Polarities -> (Polarities -> ScopeInfo) -> f ScopeInfo
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&>
  \Polarities
x -> ScopeInfo
s { _scopePolarities :: Polarities
_scopePolarities = Polarities
x }

scopeFixitiesAndPolarities :: Lens' (C.Fixities, C.Polarities) ScopeInfo
scopeFixitiesAndPolarities :: Lens' (Fixities, Polarities) ScopeInfo
scopeFixitiesAndPolarities (Fixities, Polarities) -> f (Fixities, Polarities)
f ScopeInfo
s =
  Fixities -> Polarities -> f (Fixities, Polarities)
f' (ScopeInfo -> Fixities
_scopeFixities ScopeInfo
s) (ScopeInfo -> Polarities
_scopePolarities ScopeInfo
s) f (Fixities, Polarities)
-> ((Fixities, Polarities) -> ScopeInfo) -> f ScopeInfo
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&>
  \ (Fixities
fixs, Polarities
pols) -> ScopeInfo
s { _scopeFixities :: Fixities
_scopeFixities = Fixities
fixs, _scopePolarities :: Polarities
_scopePolarities = Polarities
pols }
  where
  -- Andreas, 2019-08-18: strict matching avoids space leak, see #1829.
  f' :: Fixities -> Polarities -> f (Fixities, Polarities)
f' !Fixities
fixs !Polarities
pols = (Fixities, Polarities) -> f (Fixities, Polarities)
f (Fixities
fixs, Polarities
pols)
  -- Andrea comments on https://github.com/agda/agda/issues/1829#issuecomment-522312084
  -- on a naive version without the bang patterns:
  --
  -- useScope (because of useR) forces the result of projecting the
  -- lens, this usually prevents retaining the whole structure when we
  -- only need a field.  However your combined lens adds an extra layer
  -- of laziness with the pairs, so the actual projections remain
  -- unforced.
  --
  -- I guess scopeFixitiesAndPolarities could add some strictness when building the pair?

-- | Lens for 'scopeVarsToBind'.
updateVarsToBind :: (LocalVars -> LocalVars) -> ScopeInfo -> ScopeInfo
updateVarsToBind :: (LocalVars -> LocalVars) -> ScopeInfo -> ScopeInfo
updateVarsToBind = Lens' LocalVars ScopeInfo
-> (LocalVars -> LocalVars) -> ScopeInfo -> ScopeInfo
forall i o. Lens' i o -> LensMap i o
over (LocalVars -> f LocalVars) -> ScopeInfo -> f ScopeInfo
Lens' LocalVars ScopeInfo
scopeVarsToBind

setVarsToBind :: LocalVars -> ScopeInfo -> ScopeInfo
setVarsToBind :: LocalVars -> ScopeInfo -> ScopeInfo
setVarsToBind = Lens' LocalVars ScopeInfo -> LocalVars -> ScopeInfo -> ScopeInfo
forall i o. Lens' i o -> LensSet i o
set (LocalVars -> f LocalVars) -> ScopeInfo -> f ScopeInfo
Lens' LocalVars ScopeInfo
scopeVarsToBind

-- | Lens for 'scopeLocals'.
updateScopeLocals :: (LocalVars -> LocalVars) -> ScopeInfo -> ScopeInfo
updateScopeLocals :: (LocalVars -> LocalVars) -> ScopeInfo -> ScopeInfo
updateScopeLocals = Lens' LocalVars ScopeInfo
-> (LocalVars -> LocalVars) -> ScopeInfo -> ScopeInfo
forall i o. Lens' i o -> LensMap i o
over (LocalVars -> f LocalVars) -> ScopeInfo -> f ScopeInfo
Lens' LocalVars ScopeInfo
scopeLocals

setScopeLocals :: LocalVars -> ScopeInfo -> ScopeInfo
setScopeLocals :: LocalVars -> ScopeInfo -> ScopeInfo
setScopeLocals = Lens' LocalVars ScopeInfo -> LocalVars -> ScopeInfo -> ScopeInfo
forall i o. Lens' i o -> LensSet i o
set (LocalVars -> f LocalVars) -> ScopeInfo -> f ScopeInfo
Lens' LocalVars ScopeInfo
scopeLocals

------------------------------------------------------------------------
-- * Name spaces
--
-- Map concrete names to lists of abstract names.
------------------------------------------------------------------------

-- | A @NameSpace@ contains the mappings from concrete names that the user can
--   write to the abstract fully qualified names that the type checker wants to
--   read.
data NameSpace = NameSpace
      { NameSpace -> NamesInScope
nsNames   :: NamesInScope
        -- ^ Maps concrete names to a list of abstract names.
      , NameSpace -> ModulesInScope
nsModules :: ModulesInScope
        -- ^ Maps concrete module names to a list of abstract module names.
      , NameSpace -> InScopeSet
nsInScope :: InScopeSet
        -- ^ All abstract names targeted by a concrete name in scope.
        --   Computed by 'recomputeInScopeSets'.
      }
  deriving (NameSpace -> NameSpace -> Bool
(NameSpace -> NameSpace -> Bool)
-> (NameSpace -> NameSpace -> Bool) -> Eq NameSpace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NameSpace -> NameSpace -> Bool
== :: NameSpace -> NameSpace -> Bool
$c/= :: NameSpace -> NameSpace -> Bool
/= :: NameSpace -> NameSpace -> Bool
Eq, Int -> NameSpace -> ShowS
[NameSpace] -> ShowS
NameSpace -> FilePath
(Int -> NameSpace -> ShowS)
-> (NameSpace -> FilePath)
-> ([NameSpace] -> ShowS)
-> Show NameSpace
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NameSpace -> ShowS
showsPrec :: Int -> NameSpace -> ShowS
$cshow :: NameSpace -> FilePath
show :: NameSpace -> FilePath
$cshowList :: [NameSpace] -> ShowS
showList :: [NameSpace] -> ShowS
Show, (forall x. NameSpace -> Rep NameSpace x)
-> (forall x. Rep NameSpace x -> NameSpace) -> Generic NameSpace
forall x. Rep NameSpace x -> NameSpace
forall x. NameSpace -> Rep NameSpace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NameSpace -> Rep NameSpace x
from :: forall x. NameSpace -> Rep NameSpace x
$cto :: forall x. Rep NameSpace x -> NameSpace
to :: forall x. Rep NameSpace x -> NameSpace
Generic)

type ThingsInScope a = Map C.Name [a]
type NamesInScope    = ThingsInScope AbstractName
type ModulesInScope  = ThingsInScope AbstractModule
type InScopeSet      = Set A.QName

-- | Set of types consisting of exactly 'AbstractName' and 'AbstractModule'.
--
--   A GADT just for some dependent-types trickery.
data InScopeTag a where
  NameTag   :: InScopeTag AbstractName
  ModuleTag :: InScopeTag AbstractModule

-- | Type class for some dependent-types trickery.
class Ord a => InScope a where
  inScopeTag :: InScopeTag a

instance InScope AbstractName where
  inScopeTag :: InScopeTag AbstractName
inScopeTag = InScopeTag AbstractName
NameTag

instance InScope AbstractModule where
  inScopeTag :: InScopeTag AbstractModule
inScopeTag = InScopeTag AbstractModule
ModuleTag

-- | @inNameSpace@ selects either the name map or the module name map from
--   a 'NameSpace'.  What is selected is determined by result type
--   (using the dependent-type trickery).
inNameSpace :: forall a. InScope a => NameSpace -> ThingsInScope a
inNameSpace :: forall a. InScope a => NameSpace -> ThingsInScope a
inNameSpace = case InScopeTag a
forall a. InScope a => InScopeTag a
inScopeTag :: InScopeTag a of
  InScopeTag a
NameTag   -> NameSpace -> ThingsInScope a
NameSpace -> NamesInScope
nsNames
  InScopeTag a
ModuleTag -> NameSpace -> ThingsInScope a
NameSpace -> ModulesInScope
nsModules

-- | Non-dependent tag for name or module.
data NameOrModule = NameNotModule | ModuleNotName
  deriving (NameOrModule -> NameOrModule -> Bool
(NameOrModule -> NameOrModule -> Bool)
-> (NameOrModule -> NameOrModule -> Bool) -> Eq NameOrModule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NameOrModule -> NameOrModule -> Bool
== :: NameOrModule -> NameOrModule -> Bool
$c/= :: NameOrModule -> NameOrModule -> Bool
/= :: NameOrModule -> NameOrModule -> Bool
Eq, Eq NameOrModule
Eq NameOrModule
-> (NameOrModule -> NameOrModule -> Ordering)
-> (NameOrModule -> NameOrModule -> Bool)
-> (NameOrModule -> NameOrModule -> Bool)
-> (NameOrModule -> NameOrModule -> Bool)
-> (NameOrModule -> NameOrModule -> Bool)
-> (NameOrModule -> NameOrModule -> NameOrModule)
-> (NameOrModule -> NameOrModule -> NameOrModule)
-> Ord NameOrModule
NameOrModule -> NameOrModule -> Bool
NameOrModule -> NameOrModule -> Ordering
NameOrModule -> NameOrModule -> NameOrModule
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NameOrModule -> NameOrModule -> Ordering
compare :: NameOrModule -> NameOrModule -> Ordering
$c< :: NameOrModule -> NameOrModule -> Bool
< :: NameOrModule -> NameOrModule -> Bool
$c<= :: NameOrModule -> NameOrModule -> Bool
<= :: NameOrModule -> NameOrModule -> Bool
$c> :: NameOrModule -> NameOrModule -> Bool
> :: NameOrModule -> NameOrModule -> Bool
$c>= :: NameOrModule -> NameOrModule -> Bool
>= :: NameOrModule -> NameOrModule -> Bool
$cmax :: NameOrModule -> NameOrModule -> NameOrModule
max :: NameOrModule -> NameOrModule -> NameOrModule
$cmin :: NameOrModule -> NameOrModule -> NameOrModule
min :: NameOrModule -> NameOrModule -> NameOrModule
Ord, Int -> NameOrModule -> ShowS
[NameOrModule] -> ShowS
NameOrModule -> FilePath
(Int -> NameOrModule -> ShowS)
-> (NameOrModule -> FilePath)
-> ([NameOrModule] -> ShowS)
-> Show NameOrModule
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NameOrModule -> ShowS
showsPrec :: Int -> NameOrModule -> ShowS
$cshow :: NameOrModule -> FilePath
show :: NameOrModule -> FilePath
$cshowList :: [NameOrModule] -> ShowS
showList :: [NameOrModule] -> ShowS
Show, Int -> NameOrModule
NameOrModule -> Int
NameOrModule -> [NameOrModule]
NameOrModule -> NameOrModule
NameOrModule -> NameOrModule -> [NameOrModule]
NameOrModule -> NameOrModule -> NameOrModule -> [NameOrModule]
(NameOrModule -> NameOrModule)
-> (NameOrModule -> NameOrModule)
-> (Int -> NameOrModule)
-> (NameOrModule -> Int)
-> (NameOrModule -> [NameOrModule])
-> (NameOrModule -> NameOrModule -> [NameOrModule])
-> (NameOrModule -> NameOrModule -> [NameOrModule])
-> (NameOrModule -> NameOrModule -> NameOrModule -> [NameOrModule])
-> Enum NameOrModule
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: NameOrModule -> NameOrModule
succ :: NameOrModule -> NameOrModule
$cpred :: NameOrModule -> NameOrModule
pred :: NameOrModule -> NameOrModule
$ctoEnum :: Int -> NameOrModule
toEnum :: Int -> NameOrModule
$cfromEnum :: NameOrModule -> Int
fromEnum :: NameOrModule -> Int
$cenumFrom :: NameOrModule -> [NameOrModule]
enumFrom :: NameOrModule -> [NameOrModule]
$cenumFromThen :: NameOrModule -> NameOrModule -> [NameOrModule]
enumFromThen :: NameOrModule -> NameOrModule -> [NameOrModule]
$cenumFromTo :: NameOrModule -> NameOrModule -> [NameOrModule]
enumFromTo :: NameOrModule -> NameOrModule -> [NameOrModule]
$cenumFromThenTo :: NameOrModule -> NameOrModule -> NameOrModule -> [NameOrModule]
enumFromThenTo :: NameOrModule -> NameOrModule -> NameOrModule -> [NameOrModule]
Enum, NameOrModule
NameOrModule -> NameOrModule -> Bounded NameOrModule
forall a. a -> a -> Bounded a
$cminBound :: NameOrModule
minBound :: NameOrModule
$cmaxBound :: NameOrModule
maxBound :: NameOrModule
Bounded, (forall x. NameOrModule -> Rep NameOrModule x)
-> (forall x. Rep NameOrModule x -> NameOrModule)
-> Generic NameOrModule
forall x. Rep NameOrModule x -> NameOrModule
forall x. NameOrModule -> Rep NameOrModule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NameOrModule -> Rep NameOrModule x
from :: forall x. NameOrModule -> Rep NameOrModule x
$cto :: forall x. Rep NameOrModule x -> NameOrModule
to :: forall x. Rep NameOrModule x -> NameOrModule
Generic)

------------------------------------------------------------------------
-- * Decorated names
--
-- - What kind of name? (defined, constructor...)
-- - Where does the name come from? (to explain to user)
------------------------------------------------------------------------

-- | For the sake of parsing left-hand sides, we distinguish
--   constructor and record field names from defined names.

-- Note: order does matter in this enumeration, see 'isDefName'.
data KindOfName
  = ConName                  -- ^ Constructor name ('Inductive' or don't know).
  | CoConName                -- ^ Constructor name (definitely 'CoInductive').
  | FldName                  -- ^ Record field name.
  | PatternSynName           -- ^ Name of a pattern synonym.
  | GeneralizeName           -- ^ Name to be generalized
  | DisallowedGeneralizeName -- ^ Generalizable variable from a let open
  | MacroName                -- ^ Name of a macro
  | QuotableName             -- ^ A name that can only be quoted.
  -- Previous category @DefName@:
  -- (Refined in a flat manner as Enum and Bounded are not hereditary.)
  | DataName                 -- ^ Name of a @data@.
  | RecName                  -- ^ Name of a @record@.
  | FunName                  -- ^ Name of a defined function.
  | AxiomName                -- ^ Name of a @postulate@.
  | PrimName                 -- ^ Name of a @primitive@.
  | OtherDefName             -- ^ A @DefName@, but either other kind or don't know which kind.
  -- End @DefName@.  Keep these together in sequence, for sake of @isDefName@!
  deriving (KindOfName -> KindOfName -> Bool
(KindOfName -> KindOfName -> Bool)
-> (KindOfName -> KindOfName -> Bool) -> Eq KindOfName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KindOfName -> KindOfName -> Bool
== :: KindOfName -> KindOfName -> Bool
$c/= :: KindOfName -> KindOfName -> Bool
/= :: KindOfName -> KindOfName -> Bool
Eq, Eq KindOfName
Eq KindOfName
-> (KindOfName -> KindOfName -> Ordering)
-> (KindOfName -> KindOfName -> Bool)
-> (KindOfName -> KindOfName -> Bool)
-> (KindOfName -> KindOfName -> Bool)
-> (KindOfName -> KindOfName -> Bool)
-> (KindOfName -> KindOfName -> KindOfName)
-> (KindOfName -> KindOfName -> KindOfName)
-> Ord KindOfName
KindOfName -> KindOfName -> Bool
KindOfName -> KindOfName -> Ordering
KindOfName -> KindOfName -> KindOfName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: KindOfName -> KindOfName -> Ordering
compare :: KindOfName -> KindOfName -> Ordering
$c< :: KindOfName -> KindOfName -> Bool
< :: KindOfName -> KindOfName -> Bool
$c<= :: KindOfName -> KindOfName -> Bool
<= :: KindOfName -> KindOfName -> Bool
$c> :: KindOfName -> KindOfName -> Bool
> :: KindOfName -> KindOfName -> Bool
$c>= :: KindOfName -> KindOfName -> Bool
>= :: KindOfName -> KindOfName -> Bool
$cmax :: KindOfName -> KindOfName -> KindOfName
max :: KindOfName -> KindOfName -> KindOfName
$cmin :: KindOfName -> KindOfName -> KindOfName
min :: KindOfName -> KindOfName -> KindOfName
Ord, Int -> KindOfName -> ShowS
[KindOfName] -> ShowS
KindOfName -> FilePath
(Int -> KindOfName -> ShowS)
-> (KindOfName -> FilePath)
-> ([KindOfName] -> ShowS)
-> Show KindOfName
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KindOfName -> ShowS
showsPrec :: Int -> KindOfName -> ShowS
$cshow :: KindOfName -> FilePath
show :: KindOfName -> FilePath
$cshowList :: [KindOfName] -> ShowS
showList :: [KindOfName] -> ShowS
Show, Int -> KindOfName
KindOfName -> Int
KindOfName -> [KindOfName]
KindOfName -> KindOfName
KindOfName -> KindOfName -> [KindOfName]
KindOfName -> KindOfName -> KindOfName -> [KindOfName]
(KindOfName -> KindOfName)
-> (KindOfName -> KindOfName)
-> (Int -> KindOfName)
-> (KindOfName -> Int)
-> (KindOfName -> [KindOfName])
-> (KindOfName -> KindOfName -> [KindOfName])
-> (KindOfName -> KindOfName -> [KindOfName])
-> (KindOfName -> KindOfName -> KindOfName -> [KindOfName])
-> Enum KindOfName
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: KindOfName -> KindOfName
succ :: KindOfName -> KindOfName
$cpred :: KindOfName -> KindOfName
pred :: KindOfName -> KindOfName
$ctoEnum :: Int -> KindOfName
toEnum :: Int -> KindOfName
$cfromEnum :: KindOfName -> Int
fromEnum :: KindOfName -> Int
$cenumFrom :: KindOfName -> [KindOfName]
enumFrom :: KindOfName -> [KindOfName]
$cenumFromThen :: KindOfName -> KindOfName -> [KindOfName]
enumFromThen :: KindOfName -> KindOfName -> [KindOfName]
$cenumFromTo :: KindOfName -> KindOfName -> [KindOfName]
enumFromTo :: KindOfName -> KindOfName -> [KindOfName]
$cenumFromThenTo :: KindOfName -> KindOfName -> KindOfName -> [KindOfName]
enumFromThenTo :: KindOfName -> KindOfName -> KindOfName -> [KindOfName]
Enum, KindOfName
KindOfName -> KindOfName -> Bounded KindOfName
forall a. a -> a -> Bounded a
$cminBound :: KindOfName
minBound :: KindOfName
$cmaxBound :: KindOfName
maxBound :: KindOfName
Bounded, (forall x. KindOfName -> Rep KindOfName x)
-> (forall x. Rep KindOfName x -> KindOfName) -> Generic KindOfName
forall x. Rep KindOfName x -> KindOfName
forall x. KindOfName -> Rep KindOfName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. KindOfName -> Rep KindOfName x
from :: forall x. KindOfName -> Rep KindOfName x
$cto :: forall x. Rep KindOfName x -> KindOfName
to :: forall x. Rep KindOfName x -> KindOfName
Generic)

isDefName :: KindOfName -> Bool
isDefName :: KindOfName -> Bool
isDefName = (KindOfName -> KindOfName -> Bool
forall a. Ord a => a -> a -> Bool
>= KindOfName
DataName)

isConName :: KindOfName -> Maybe Induction
isConName :: KindOfName -> Maybe Induction
isConName = \case
  KindOfName
ConName   -> Induction -> Maybe Induction
forall a. a -> Maybe a
Just Induction
Inductive
  KindOfName
CoConName -> Induction -> Maybe Induction
forall a. a -> Maybe a
Just Induction
CoInductive
  KindOfName
_ -> Maybe Induction
forall a. Maybe a
Nothing

conKindOfName :: Induction -> KindOfName
conKindOfName :: Induction -> KindOfName
conKindOfName = \case
  Induction
Inductive   -> KindOfName
ConName
  Induction
CoInductive -> KindOfName
CoConName

-- | For ambiguous constructors, we might have both alternatives of 'Induction'.
--   In this case, we default to 'ConName'.
conKindOfName' :: Foldable t => t Induction -> KindOfName
conKindOfName' :: forall (t :: * -> *). Foldable t => t Induction -> KindOfName
conKindOfName' = Induction -> KindOfName
conKindOfName (Induction -> KindOfName)
-> (t Induction -> Induction) -> t Induction -> KindOfName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t Induction -> Induction
forall (t :: * -> *). Foldable t => t Induction -> Induction
approxConInduction

-- | For ambiguous constructors, we might have both alternatives of 'Induction'.
--   In this case, we default to 'Inductive'.
approxConInduction :: Foldable t => t Induction -> Induction
approxConInduction :: forall (t :: * -> *). Foldable t => t Induction -> Induction
approxConInduction = Induction -> Maybe Induction -> Induction
forall a. a -> Maybe a -> a
fromMaybe Induction
Inductive (Maybe Induction -> Induction)
-> (t Induction -> Maybe Induction) -> t Induction -> Induction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t Induction -> Maybe Induction
forall (t :: * -> *). Foldable t => t Induction -> Maybe Induction
exactConInduction

exactConInduction :: Foldable t => t Induction -> Maybe Induction
exactConInduction :: forall (t :: * -> *). Foldable t => t Induction -> Maybe Induction
exactConInduction t Induction
is = case t Induction -> [Induction]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Induction
is of
  [Induction
CoInductive] -> Induction -> Maybe Induction
forall a. a -> Maybe a
Just Induction
CoInductive
  [Induction
Inductive]   -> Induction -> Maybe Induction
forall a. a -> Maybe a
Just Induction
Inductive
  [Induction]
_ -> Maybe Induction
forall a. Maybe a
Nothing

-- | Only return @[Co]ConName@ if no ambiguity.
exactConName :: Foldable t => t Induction -> Maybe KindOfName
exactConName :: forall (t :: * -> *). Foldable t => t Induction -> Maybe KindOfName
exactConName = (Induction -> KindOfName) -> Maybe Induction -> Maybe KindOfName
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Induction -> KindOfName
conKindOfName (Maybe Induction -> Maybe KindOfName)
-> (t Induction -> Maybe Induction)
-> t Induction
-> Maybe KindOfName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t Induction -> Maybe Induction
forall (t :: * -> *). Foldable t => t Induction -> Maybe Induction
exactConInduction

-- | A set of 'KindOfName', for the sake of 'elemKindsOfNames'.
data KindsOfNames
  = AllKindsOfNames
  | SomeKindsOfNames   (Set KindOfName)  -- ^ Only these kinds.
  | ExceptKindsOfNames (Set KindOfName)  -- ^ All but these Kinds.

elemKindsOfNames :: KindOfName -> KindsOfNames -> Bool
elemKindsOfNames :: KindOfName -> KindsOfNames -> Bool
elemKindsOfNames KindOfName
k = \case
  KindsOfNames
AllKindsOfNames       -> Bool
True
  SomeKindsOfNames   Set KindOfName
ks -> KindOfName
k KindOfName -> Set KindOfName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set KindOfName
ks
  ExceptKindsOfNames Set KindOfName
ks -> KindOfName
k KindOfName -> Set KindOfName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set KindOfName
ks

allKindsOfNames :: KindsOfNames
allKindsOfNames :: KindsOfNames
allKindsOfNames = KindsOfNames
AllKindsOfNames

someKindsOfNames :: [KindOfName] -> KindsOfNames
someKindsOfNames :: [KindOfName] -> KindsOfNames
someKindsOfNames = Set KindOfName -> KindsOfNames
SomeKindsOfNames (Set KindOfName -> KindsOfNames)
-> ([KindOfName] -> Set KindOfName) -> [KindOfName] -> KindsOfNames
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [KindOfName] -> Set KindOfName
forall a. Ord a => [a] -> Set a
Set.fromList

exceptKindsOfNames :: [KindOfName] -> KindsOfNames
exceptKindsOfNames :: [KindOfName] -> KindsOfNames
exceptKindsOfNames = Set KindOfName -> KindsOfNames
ExceptKindsOfNames (Set KindOfName -> KindsOfNames)
-> ([KindOfName] -> Set KindOfName) -> [KindOfName] -> KindsOfNames
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [KindOfName] -> Set KindOfName
forall a. Ord a => [a] -> Set a
Set.fromList

-- | Decorate something with 'KindOfName'

data WithKind a = WithKind
  { forall a. WithKind a -> KindOfName
theKind     :: KindOfName
  , forall a. WithKind a -> a
kindedThing :: a
  } deriving (Int -> WithKind a -> ShowS
[WithKind a] -> ShowS
WithKind a -> FilePath
(Int -> WithKind a -> ShowS)
-> (WithKind a -> FilePath)
-> ([WithKind a] -> ShowS)
-> Show (WithKind a)
forall a. Show a => Int -> WithKind a -> ShowS
forall a. Show a => [WithKind a] -> ShowS
forall a. Show a => WithKind a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WithKind a -> ShowS
showsPrec :: Int -> WithKind a -> ShowS
$cshow :: forall a. Show a => WithKind a -> FilePath
show :: WithKind a -> FilePath
$cshowList :: forall a. Show a => [WithKind a] -> ShowS
showList :: [WithKind a] -> ShowS
Show, WithKind a -> WithKind a -> Bool
(WithKind a -> WithKind a -> Bool)
-> (WithKind a -> WithKind a -> Bool) -> Eq (WithKind a)
forall a. Eq a => WithKind a -> WithKind a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => WithKind a -> WithKind a -> Bool
== :: WithKind a -> WithKind a -> Bool
$c/= :: forall a. Eq a => WithKind a -> WithKind a -> Bool
/= :: WithKind a -> WithKind a -> Bool
Eq, Eq (WithKind a)
Eq (WithKind a)
-> (WithKind a -> WithKind a -> Ordering)
-> (WithKind a -> WithKind a -> Bool)
-> (WithKind a -> WithKind a -> Bool)
-> (WithKind a -> WithKind a -> Bool)
-> (WithKind a -> WithKind a -> Bool)
-> (WithKind a -> WithKind a -> WithKind a)
-> (WithKind a -> WithKind a -> WithKind a)
-> Ord (WithKind a)
WithKind a -> WithKind a -> Bool
WithKind a -> WithKind a -> Ordering
WithKind a -> WithKind a -> WithKind a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (WithKind a)
forall a. Ord a => WithKind a -> WithKind a -> Bool
forall a. Ord a => WithKind a -> WithKind a -> Ordering
forall a. Ord a => WithKind a -> WithKind a -> WithKind a
$ccompare :: forall a. Ord a => WithKind a -> WithKind a -> Ordering
compare :: WithKind a -> WithKind a -> Ordering
$c< :: forall a. Ord a => WithKind a -> WithKind a -> Bool
< :: WithKind a -> WithKind a -> Bool
$c<= :: forall a. Ord a => WithKind a -> WithKind a -> Bool
<= :: WithKind a -> WithKind a -> Bool
$c> :: forall a. Ord a => WithKind a -> WithKind a -> Bool
> :: WithKind a -> WithKind a -> Bool
$c>= :: forall a. Ord a => WithKind a -> WithKind a -> Bool
>= :: WithKind a -> WithKind a -> Bool
$cmax :: forall a. Ord a => WithKind a -> WithKind a -> WithKind a
max :: WithKind a -> WithKind a -> WithKind a
$cmin :: forall a. Ord a => WithKind a -> WithKind a -> WithKind a
min :: WithKind a -> WithKind a -> WithKind a
Ord, (forall a b. (a -> b) -> WithKind a -> WithKind b)
-> (forall a b. a -> WithKind b -> WithKind a) -> Functor WithKind
forall a b. a -> WithKind b -> WithKind a
forall a b. (a -> b) -> WithKind a -> WithKind b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> WithKind a -> WithKind b
fmap :: forall a b. (a -> b) -> WithKind a -> WithKind b
$c<$ :: forall a b. a -> WithKind b -> WithKind a
<$ :: forall a b. a -> WithKind b -> WithKind a
Functor, (forall m. Monoid m => WithKind m -> m)
-> (forall m a. Monoid m => (a -> m) -> WithKind a -> m)
-> (forall m a. Monoid m => (a -> m) -> WithKind a -> m)
-> (forall a b. (a -> b -> b) -> b -> WithKind a -> b)
-> (forall a b. (a -> b -> b) -> b -> WithKind a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithKind a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithKind a -> b)
-> (forall a. (a -> a -> a) -> WithKind a -> a)
-> (forall a. (a -> a -> a) -> WithKind a -> a)
-> (forall a. WithKind a -> [a])
-> (forall a. WithKind a -> Bool)
-> (forall a. WithKind a -> Int)
-> (forall a. Eq a => a -> WithKind a -> Bool)
-> (forall a. Ord a => WithKind a -> a)
-> (forall a. Ord a => WithKind a -> a)
-> (forall a. Num a => WithKind a -> a)
-> (forall a. Num a => WithKind a -> a)
-> Foldable WithKind
forall a. Eq a => a -> WithKind a -> Bool
forall a. Num a => WithKind a -> a
forall a. Ord a => WithKind a -> a
forall m. Monoid m => WithKind m -> m
forall a. WithKind a -> Bool
forall a. WithKind a -> Int
forall a. WithKind a -> [a]
forall a. (a -> a -> a) -> WithKind a -> a
forall m a. Monoid m => (a -> m) -> WithKind a -> m
forall b a. (b -> a -> b) -> b -> WithKind a -> b
forall a b. (a -> b -> b) -> b -> WithKind a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => WithKind m -> m
fold :: forall m. Monoid m => WithKind m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> WithKind a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> WithKind a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> WithKind a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> WithKind a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> WithKind a -> b
foldr :: forall a b. (a -> b -> b) -> b -> WithKind a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> WithKind a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> WithKind a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> WithKind a -> b
foldl :: forall b a. (b -> a -> b) -> b -> WithKind a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> WithKind a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> WithKind a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> WithKind a -> a
foldr1 :: forall a. (a -> a -> a) -> WithKind a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> WithKind a -> a
foldl1 :: forall a. (a -> a -> a) -> WithKind a -> a
$ctoList :: forall a. WithKind a -> [a]
toList :: forall a. WithKind a -> [a]
$cnull :: forall a. WithKind a -> Bool
null :: forall a. WithKind a -> Bool
$clength :: forall a. WithKind a -> Int
length :: forall a. WithKind a -> Int
$celem :: forall a. Eq a => a -> WithKind a -> Bool
elem :: forall a. Eq a => a -> WithKind a -> Bool
$cmaximum :: forall a. Ord a => WithKind a -> a
maximum :: forall a. Ord a => WithKind a -> a
$cminimum :: forall a. Ord a => WithKind a -> a
minimum :: forall a. Ord a => WithKind a -> a
$csum :: forall a. Num a => WithKind a -> a
sum :: forall a. Num a => WithKind a -> a
$cproduct :: forall a. Num a => WithKind a -> a
product :: forall a. Num a => WithKind a -> a
Foldable, Functor WithKind
Foldable WithKind
Functor WithKind
-> Foldable WithKind
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> WithKind a -> f (WithKind b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    WithKind (f a) -> f (WithKind a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> WithKind a -> m (WithKind b))
-> (forall (m :: * -> *) a.
    Monad m =>
    WithKind (m a) -> m (WithKind a))
-> Traversable WithKind
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => WithKind (m a) -> m (WithKind a)
forall (f :: * -> *) a.
Applicative f =>
WithKind (f a) -> f (WithKind a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithKind a -> m (WithKind b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithKind a -> f (WithKind b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithKind a -> f (WithKind b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithKind a -> f (WithKind b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithKind (f a) -> f (WithKind a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithKind (f a) -> f (WithKind a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithKind a -> m (WithKind b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithKind a -> m (WithKind b)
$csequence :: forall (m :: * -> *) a. Monad m => WithKind (m a) -> m (WithKind a)
sequence :: forall (m :: * -> *) a. Monad m => WithKind (m a) -> m (WithKind a)
Traversable)

-- | Where does a name come from?
--
--   This information is solely for reporting to the user,
--   see 'Agda.Interaction.InteractionTop.whyInScope'.
data WhyInScope
  = Defined
    -- ^ Defined in this module.
  | Opened C.QName WhyInScope
    -- ^ Imported from another module.
  | Applied C.QName WhyInScope
    -- ^ Imported by a module application.
  deriving (Int -> WhyInScope -> ShowS
[WhyInScope] -> ShowS
WhyInScope -> FilePath
(Int -> WhyInScope -> ShowS)
-> (WhyInScope -> FilePath)
-> ([WhyInScope] -> ShowS)
-> Show WhyInScope
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WhyInScope -> ShowS
showsPrec :: Int -> WhyInScope -> ShowS
$cshow :: WhyInScope -> FilePath
show :: WhyInScope -> FilePath
$cshowList :: [WhyInScope] -> ShowS
showList :: [WhyInScope] -> ShowS
Show, (forall x. WhyInScope -> Rep WhyInScope x)
-> (forall x. Rep WhyInScope x -> WhyInScope) -> Generic WhyInScope
forall x. Rep WhyInScope x -> WhyInScope
forall x. WhyInScope -> Rep WhyInScope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WhyInScope -> Rep WhyInScope x
from :: forall x. WhyInScope -> Rep WhyInScope x
$cto :: forall x. Rep WhyInScope x -> WhyInScope
to :: forall x. Rep WhyInScope x -> WhyInScope
Generic)

-- | A decoration of 'Agda.Syntax.Abstract.Name.QName'.
data AbstractName = AbsName
  { AbstractName -> QName
anameName    :: A.QName
    -- ^ The resolved qualified name.
  , AbstractName -> KindOfName
anameKind    :: KindOfName
    -- ^ The kind (definition, constructor, record field etc.).
  , AbstractName -> WhyInScope
anameLineage :: WhyInScope
    -- ^ Explanation where this name came from.
  , AbstractName -> NameMetadata
anameMetadata :: NameMetadata
    -- ^ Additional information needed during scope checking. Currently used
    --   for generalized data/record params.
  }
  deriving (Int -> AbstractName -> ShowS
[AbstractName] -> ShowS
AbstractName -> FilePath
(Int -> AbstractName -> ShowS)
-> (AbstractName -> FilePath)
-> ([AbstractName] -> ShowS)
-> Show AbstractName
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbstractName -> ShowS
showsPrec :: Int -> AbstractName -> ShowS
$cshow :: AbstractName -> FilePath
show :: AbstractName -> FilePath
$cshowList :: [AbstractName] -> ShowS
showList :: [AbstractName] -> ShowS
Show, (forall x. AbstractName -> Rep AbstractName x)
-> (forall x. Rep AbstractName x -> AbstractName)
-> Generic AbstractName
forall x. Rep AbstractName x -> AbstractName
forall x. AbstractName -> Rep AbstractName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AbstractName -> Rep AbstractName x
from :: forall x. AbstractName -> Rep AbstractName x
$cto :: forall x. Rep AbstractName x -> AbstractName
to :: forall x. Rep AbstractName x -> AbstractName
Generic)

data NameMetadata = NoMetadata
                  | GeneralizedVarsMetadata (Map A.QName A.Name)
  deriving (Int -> NameMetadata -> ShowS
[NameMetadata] -> ShowS
NameMetadata -> FilePath
(Int -> NameMetadata -> ShowS)
-> (NameMetadata -> FilePath)
-> ([NameMetadata] -> ShowS)
-> Show NameMetadata
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NameMetadata -> ShowS
showsPrec :: Int -> NameMetadata -> ShowS
$cshow :: NameMetadata -> FilePath
show :: NameMetadata -> FilePath
$cshowList :: [NameMetadata] -> ShowS
showList :: [NameMetadata] -> ShowS
Show, (forall x. NameMetadata -> Rep NameMetadata x)
-> (forall x. Rep NameMetadata x -> NameMetadata)
-> Generic NameMetadata
forall x. Rep NameMetadata x -> NameMetadata
forall x. NameMetadata -> Rep NameMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NameMetadata -> Rep NameMetadata x
from :: forall x. NameMetadata -> Rep NameMetadata x
$cto :: forall x. Rep NameMetadata x -> NameMetadata
to :: forall x. Rep NameMetadata x -> NameMetadata
Generic)

-- | A decoration of abstract syntax module names.
data AbstractModule = AbsModule
  { AbstractModule -> ModuleName
amodName    :: A.ModuleName
    -- ^ The resolved module name.
  , AbstractModule -> WhyInScope
amodLineage :: WhyInScope
    -- ^ Explanation where this name came from.
  }
  deriving (Int -> AbstractModule -> ShowS
[AbstractModule] -> ShowS
AbstractModule -> FilePath
(Int -> AbstractModule -> ShowS)
-> (AbstractModule -> FilePath)
-> ([AbstractModule] -> ShowS)
-> Show AbstractModule
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbstractModule -> ShowS
showsPrec :: Int -> AbstractModule -> ShowS
$cshow :: AbstractModule -> FilePath
show :: AbstractModule -> FilePath
$cshowList :: [AbstractModule] -> ShowS
showList :: [AbstractModule] -> ShowS
Show, (forall x. AbstractModule -> Rep AbstractModule x)
-> (forall x. Rep AbstractModule x -> AbstractModule)
-> Generic AbstractModule
forall x. Rep AbstractModule x -> AbstractModule
forall x. AbstractModule -> Rep AbstractModule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AbstractModule -> Rep AbstractModule x
from :: forall x. AbstractModule -> Rep AbstractModule x
$cto :: forall x. Rep AbstractModule x -> AbstractModule
to :: forall x. Rep AbstractModule x -> AbstractModule
Generic)

instance Eq AbstractName where
  == :: AbstractName -> AbstractName -> Bool
(==) = QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (QName -> QName -> Bool)
-> (AbstractName -> QName) -> AbstractName -> AbstractName -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` AbstractName -> QName
anameName

instance Ord AbstractName where
  compare :: AbstractName -> AbstractName -> Ordering
compare = QName -> QName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (QName -> QName -> Ordering)
-> (AbstractName -> QName)
-> AbstractName
-> AbstractName
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` AbstractName -> QName
anameName

instance LensFixity AbstractName where
  lensFixity :: Lens' Fixity AbstractName
lensFixity = (QName -> f QName) -> AbstractName -> f AbstractName
Lens' QName AbstractName
lensAnameName ((QName -> f QName) -> AbstractName -> f AbstractName)
-> ((Fixity -> f Fixity) -> QName -> f QName)
-> (Fixity -> f Fixity)
-> AbstractName
-> f AbstractName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fixity -> f Fixity) -> QName -> f QName
forall a. LensFixity a => Lens' Fixity a
Lens' Fixity QName
lensFixity

-- | Van Laarhoven lens on 'anameName'.
lensAnameName :: Lens' A.QName AbstractName
lensAnameName :: Lens' QName AbstractName
lensAnameName QName -> f QName
f AbstractName
am = QName -> f QName
f (AbstractName -> QName
anameName AbstractName
am) f QName -> (QName -> AbstractName) -> f AbstractName
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&> \ QName
m -> AbstractName
am { anameName :: QName
anameName = QName
m }

instance Eq AbstractModule where
  == :: AbstractModule -> AbstractModule -> Bool
(==) = ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ModuleName -> ModuleName -> Bool)
-> (AbstractModule -> ModuleName)
-> AbstractModule
-> AbstractModule
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` AbstractModule -> ModuleName
amodName

instance Ord AbstractModule where
  compare :: AbstractModule -> AbstractModule -> Ordering
compare = ModuleName -> ModuleName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ModuleName -> ModuleName -> Ordering)
-> (AbstractModule -> ModuleName)
-> AbstractModule
-> AbstractModule
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` AbstractModule -> ModuleName
amodName

-- | Van Laarhoven lens on 'amodName'.
lensAmodName :: Lens' A.ModuleName AbstractModule
lensAmodName :: Lens' ModuleName AbstractModule
lensAmodName ModuleName -> f ModuleName
f AbstractModule
am = ModuleName -> f ModuleName
f (AbstractModule -> ModuleName
amodName AbstractModule
am) f ModuleName -> (ModuleName -> AbstractModule) -> f AbstractModule
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&> \ ModuleName
m -> AbstractModule
am { amodName :: ModuleName
amodName = ModuleName
m }


data ResolvedName
  = -- | Local variable bound by λ, Π, module telescope, pattern, @let@.
    VarName
    { ResolvedName -> Name
resolvedVar           :: A.Name
    , ResolvedName -> BindingSource
resolvedBindingSource :: BindingSource    -- ^ What kind of binder?
    }

  | -- | Function, data/record type, postulate.
    DefinedName Access AbstractName A.Suffix -- ^ 'anameKind' can be 'DefName', 'MacroName', 'QuotableName'.

  | -- | Record field name.  Needs to be distinguished to parse copatterns.
    FieldName (List1 AbstractName)       -- ^ @('FldName' ==) . 'anameKind'@ for all names.

  | -- | Data or record constructor name.
    ConstructorName (Set Induction) (List1 AbstractName) -- ^ @isJust . 'isConName' . 'anameKind'@ for all names.

  | -- | Name of pattern synonym.
    PatternSynResName (List1 AbstractName) -- ^ @('PatternSynName' ==) . 'anameKind'@ for all names.

  | -- | Unbound name.
    UnknownName
  deriving (Int -> ResolvedName -> ShowS
[ResolvedName] -> ShowS
ResolvedName -> FilePath
(Int -> ResolvedName -> ShowS)
-> (ResolvedName -> FilePath)
-> ([ResolvedName] -> ShowS)
-> Show ResolvedName
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResolvedName -> ShowS
showsPrec :: Int -> ResolvedName -> ShowS
$cshow :: ResolvedName -> FilePath
show :: ResolvedName -> FilePath
$cshowList :: [ResolvedName] -> ShowS
showList :: [ResolvedName] -> ShowS
Show, ResolvedName -> ResolvedName -> Bool
(ResolvedName -> ResolvedName -> Bool)
-> (ResolvedName -> ResolvedName -> Bool) -> Eq ResolvedName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResolvedName -> ResolvedName -> Bool
== :: ResolvedName -> ResolvedName -> Bool
$c/= :: ResolvedName -> ResolvedName -> Bool
/= :: ResolvedName -> ResolvedName -> Bool
Eq, (forall x. ResolvedName -> Rep ResolvedName x)
-> (forall x. Rep ResolvedName x -> ResolvedName)
-> Generic ResolvedName
forall x. Rep ResolvedName x -> ResolvedName
forall x. ResolvedName -> Rep ResolvedName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResolvedName -> Rep ResolvedName x
from :: forall x. ResolvedName -> Rep ResolvedName x
$cto :: forall x. Rep ResolvedName x -> ResolvedName
to :: forall x. Rep ResolvedName x -> ResolvedName
Generic)

instance Pretty ResolvedName where
  pretty :: ResolvedName -> Doc
pretty = \case
    VarName Name
x BindingSource
b          -> BindingSource -> Doc
forall a. Pretty a => a -> Doc
pretty BindingSource
b Doc -> Doc -> Doc
<+> Doc
"variable" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Pretty a => a -> Doc
pretty Name
x
    DefinedName Access
a AbstractName
x Suffix
s    -> Access -> Doc
forall a. Pretty a => a -> Doc
pretty Access
a      Doc -> Doc -> Doc
<+> (AbstractName -> Doc
forall a. Pretty a => a -> Doc
pretty AbstractName
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Suffix -> Doc
forall a. Pretty a => a -> Doc
pretty Suffix
s)
    FieldName List1 AbstractName
xs         -> Doc
"field"       Doc -> Doc -> Doc
<+> List1 AbstractName -> Doc
forall a. Pretty a => a -> Doc
pretty List1 AbstractName
xs
    ConstructorName Set Induction
_ List1 AbstractName
xs -> Doc
"constructor" Doc -> Doc -> Doc
<+> List1 AbstractName -> Doc
forall a. Pretty a => a -> Doc
pretty List1 AbstractName
xs
    PatternSynResName List1 AbstractName
x  -> Doc
"pattern"     Doc -> Doc -> Doc
<+> List1 AbstractName -> Doc
forall a. Pretty a => a -> Doc
pretty List1 AbstractName
x
    ResolvedName
UnknownName          -> Doc
"<unknown name>"

instance Pretty A.Suffix where
  pretty :: Suffix -> Doc
pretty Suffix
NoSuffix   = Doc
forall a. Monoid a => a
mempty
  pretty (Suffix Integer
i) = FilePath -> Doc
text (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
i)

-- | Why is a resolved name ambiguous?  What did it resolve to?
--
--   Invariant (statically enforced): At least two resolvents in total.
data AmbiguousNameReason
  = AmbiguousLocalVar LocalVar (List1 AbstractName)
      -- ^ The name resolves both to a local variable and some declared names.
  | AmbiguousDeclName (List2 AbstractName)
      -- ^ The name resolves to at least 2 declared names.
  deriving (Int -> AmbiguousNameReason -> ShowS
[AmbiguousNameReason] -> ShowS
AmbiguousNameReason -> FilePath
(Int -> AmbiguousNameReason -> ShowS)
-> (AmbiguousNameReason -> FilePath)
-> ([AmbiguousNameReason] -> ShowS)
-> Show AmbiguousNameReason
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AmbiguousNameReason -> ShowS
showsPrec :: Int -> AmbiguousNameReason -> ShowS
$cshow :: AmbiguousNameReason -> FilePath
show :: AmbiguousNameReason -> FilePath
$cshowList :: [AmbiguousNameReason] -> ShowS
showList :: [AmbiguousNameReason] -> ShowS
Show, (forall x. AmbiguousNameReason -> Rep AmbiguousNameReason x)
-> (forall x. Rep AmbiguousNameReason x -> AmbiguousNameReason)
-> Generic AmbiguousNameReason
forall x. Rep AmbiguousNameReason x -> AmbiguousNameReason
forall x. AmbiguousNameReason -> Rep AmbiguousNameReason x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AmbiguousNameReason -> Rep AmbiguousNameReason x
from :: forall x. AmbiguousNameReason -> Rep AmbiguousNameReason x
$cto :: forall x. Rep AmbiguousNameReason x -> AmbiguousNameReason
to :: forall x. Rep AmbiguousNameReason x -> AmbiguousNameReason
Generic)

-- | The flat list of ambiguous names in 'AmbiguousNameReason'.
ambiguousNamesInReason :: AmbiguousNameReason -> List2 (A.QName)
ambiguousNamesInReason :: AmbiguousNameReason -> List2 QName
ambiguousNamesInReason = \case
  AmbiguousLocalVar (LocalVar Name
y BindingSource
_ [AbstractName]
_) List1 AbstractName
xs -> QName -> List1 QName -> List2 QName
forall a. a -> List1 a -> List2 a
List2.cons (Name -> QName
A.qualify_ Name
y) (List1 QName -> List2 QName) -> List1 QName -> List2 QName
forall a b. (a -> b) -> a -> b
$ (AbstractName -> QName) -> List1 AbstractName -> List1 QName
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AbstractName -> QName
anameName List1 AbstractName
xs
  AmbiguousDeclName List2 AbstractName
xs -> (AbstractName -> QName) -> List2 AbstractName -> List2 QName
forall a b. (a -> b) -> List2 a -> List2 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AbstractName -> QName
anameName List2 AbstractName
xs

data WhyInScopeData
  = WhyInScopeData
      C.QName
        -- ^ The name @x@ this explanation is about.
      FilePath
        -- ^ The directory in which the current module resides.
      (Maybe LocalVar)
        -- ^ The local variable that @x@ could denote, if any.
      [AbstractName]
        -- ^ The defined names that @x@ could denote.
      [AbstractModule]
        -- ^ The modules that @x@ could denote.

whyInScopeDataFromAmbiguousNameReason :: C.QName -> AmbiguousNameReason -> WhyInScopeData
whyInScopeDataFromAmbiguousNameReason :: QName -> AmbiguousNameReason -> WhyInScopeData
whyInScopeDataFromAmbiguousNameReason QName
q = \case
  AmbiguousLocalVar LocalVar
x List1 AbstractName
ys -> QName
-> FilePath
-> Maybe LocalVar
-> [AbstractName]
-> [AbstractModule]
-> WhyInScopeData
WhyInScopeData QName
q FilePath
forall a. Null a => a
empty (LocalVar -> Maybe LocalVar
forall a. a -> Maybe a
Just LocalVar
x) (List1 AbstractName -> [AbstractName]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List1 AbstractName
ys) [AbstractModule]
forall a. Null a => a
empty
  AmbiguousDeclName List2 AbstractName
ys   -> QName
-> FilePath
-> Maybe LocalVar
-> [AbstractName]
-> [AbstractModule]
-> WhyInScopeData
WhyInScopeData QName
q FilePath
forall a. Null a => a
empty Maybe LocalVar
forall a. Maybe a
Nothing  (List2 AbstractName -> [AbstractName]
forall a. List2 a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List2 AbstractName
ys) [AbstractModule]
forall a. Null a => a
empty

-- * Operations on name and module maps.

mergeNames :: Eq a => ThingsInScope a -> ThingsInScope a -> ThingsInScope a
mergeNames :: forall a.
Eq a =>
ThingsInScope a -> ThingsInScope a -> ThingsInScope a
mergeNames = ([a] -> [a] -> [a]) -> Map Name [a] -> Map Name [a] -> Map Name [a]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
List.union

mergeNamesMany :: Eq a => [ThingsInScope a] -> ThingsInScope a
mergeNamesMany :: forall a. Eq a => [ThingsInScope a] -> ThingsInScope a
mergeNamesMany = ([a] -> [a] -> [a]) -> [Map Name [a]] -> Map Name [a]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
List.union

------------------------------------------------------------------------
-- * Operations on name spaces
------------------------------------------------------------------------

-- | The empty name space.
emptyNameSpace :: NameSpace
emptyNameSpace :: NameSpace
emptyNameSpace = NamesInScope -> ModulesInScope -> InScopeSet -> NameSpace
NameSpace NamesInScope
forall k a. Map k a
Map.empty ModulesInScope
forall k a. Map k a
Map.empty InScopeSet
forall a. Set a
Set.empty


-- | Map functions over the names and modules in a name space.
mapNameSpace :: (NamesInScope   -> NamesInScope  ) ->
                (ModulesInScope -> ModulesInScope) ->
                (InScopeSet     -> InScopeSet    ) ->
                NameSpace -> NameSpace
mapNameSpace :: (NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet)
-> NameSpace
-> NameSpace
mapNameSpace NamesInScope -> NamesInScope
fd ModulesInScope -> ModulesInScope
fm InScopeSet -> InScopeSet
fs NameSpace
ns =
  NameSpace
ns { nsNames :: NamesInScope
nsNames   = NamesInScope -> NamesInScope
fd (NamesInScope -> NamesInScope) -> NamesInScope -> NamesInScope
forall a b. (a -> b) -> a -> b
$ NameSpace -> NamesInScope
nsNames   NameSpace
ns
     , nsModules :: ModulesInScope
nsModules = ModulesInScope -> ModulesInScope
fm (ModulesInScope -> ModulesInScope)
-> ModulesInScope -> ModulesInScope
forall a b. (a -> b) -> a -> b
$ NameSpace -> ModulesInScope
nsModules NameSpace
ns
     , nsInScope :: InScopeSet
nsInScope = InScopeSet -> InScopeSet
fs (InScopeSet -> InScopeSet) -> InScopeSet -> InScopeSet
forall a b. (a -> b) -> a -> b
$ NameSpace -> InScopeSet
nsInScope NameSpace
ns
     }

-- | Zip together two name spaces.
zipNameSpace :: (NamesInScope   -> NamesInScope   -> NamesInScope  ) ->
                (ModulesInScope -> ModulesInScope -> ModulesInScope) ->
                (InScopeSet     -> InScopeSet     -> InScopeSet    ) ->
                NameSpace -> NameSpace -> NameSpace
zipNameSpace :: (NamesInScope -> NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet -> InScopeSet)
-> NameSpace
-> NameSpace
-> NameSpace
zipNameSpace NamesInScope -> NamesInScope -> NamesInScope
fd ModulesInScope -> ModulesInScope -> ModulesInScope
fm InScopeSet -> InScopeSet -> InScopeSet
fs NameSpace
ns1 NameSpace
ns2 =
  NameSpace
ns1 { nsNames :: NamesInScope
nsNames   = NameSpace -> NamesInScope
nsNames   NameSpace
ns1 NamesInScope -> NamesInScope -> NamesInScope
`fd` NameSpace -> NamesInScope
nsNames   NameSpace
ns2
      , nsModules :: ModulesInScope
nsModules = NameSpace -> ModulesInScope
nsModules NameSpace
ns1 ModulesInScope -> ModulesInScope -> ModulesInScope
`fm` NameSpace -> ModulesInScope
nsModules NameSpace
ns2
      , nsInScope :: InScopeSet
nsInScope = NameSpace -> InScopeSet
nsInScope NameSpace
ns1 InScopeSet -> InScopeSet -> InScopeSet
`fs` NameSpace -> InScopeSet
nsInScope NameSpace
ns2
      }

-- | Map monadic function over a namespace.
mapNameSpaceM :: Applicative m =>
  (NamesInScope   -> m NamesInScope  ) ->
  (ModulesInScope -> m ModulesInScope) ->
  (InScopeSet     -> m InScopeSet    ) ->
  NameSpace -> m NameSpace
mapNameSpaceM :: forall (m :: * -> *).
Applicative m =>
(NamesInScope -> m NamesInScope)
-> (ModulesInScope -> m ModulesInScope)
-> (InScopeSet -> m InScopeSet)
-> NameSpace
-> m NameSpace
mapNameSpaceM NamesInScope -> m NamesInScope
fd ModulesInScope -> m ModulesInScope
fm InScopeSet -> m InScopeSet
fs NameSpace
ns = NameSpace
-> NamesInScope -> ModulesInScope -> InScopeSet -> NameSpace
update NameSpace
ns (NamesInScope -> ModulesInScope -> InScopeSet -> NameSpace)
-> m NamesInScope -> m (ModulesInScope -> InScopeSet -> NameSpace)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesInScope -> m NamesInScope
fd (NameSpace -> NamesInScope
nsNames NameSpace
ns) m (ModulesInScope -> InScopeSet -> NameSpace)
-> m ModulesInScope -> m (InScopeSet -> NameSpace)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ModulesInScope -> m ModulesInScope
fm (NameSpace -> ModulesInScope
nsModules NameSpace
ns) m (InScopeSet -> NameSpace) -> m InScopeSet -> m NameSpace
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InScopeSet -> m InScopeSet
fs (NameSpace -> InScopeSet
nsInScope NameSpace
ns)
  where
    update :: NameSpace
-> NamesInScope -> ModulesInScope -> InScopeSet -> NameSpace
update NameSpace
ns NamesInScope
ds ModulesInScope
ms InScopeSet
is = NameSpace
ns { nsNames :: NamesInScope
nsNames = NamesInScope
ds, nsModules :: ModulesInScope
nsModules = ModulesInScope
ms, nsInScope :: InScopeSet
nsInScope = InScopeSet
is }

------------------------------------------------------------------------
-- * General operations on scopes
------------------------------------------------------------------------

instance Null Scope where
  empty :: Scope
empty = Scope
emptyScope
  null :: Scope -> Bool
null  = Scope -> Bool
forall a. HasCallStack => a
__IMPOSSIBLE__
    -- TODO: define when needed, careful about scopeNameSpaces!

instance Null ScopeInfo where
  empty :: ScopeInfo
empty = ScopeInfo
emptyScopeInfo
  null :: ScopeInfo -> Bool
null  = ScopeInfo -> Bool
forall a. HasCallStack => a
__IMPOSSIBLE__
    -- TODO: define when needed, careful about _scopeModules!

-- | The empty scope.
emptyScope :: Scope
emptyScope :: Scope
emptyScope = Scope
  { scopeName :: ModuleName
scopeName           = ModuleName
noModuleName
  , scopeParents :: [ModuleName]
scopeParents        = []
  , scopeNameSpaces :: ScopeNameSpaces
scopeNameSpaces     = [ (NameSpaceId
nsid, NameSpace
emptyNameSpace) | NameSpaceId
nsid <- [NameSpaceId]
allNameSpaces ]
      -- Note (Andreas, 2019-08-19):  Cannot have [] here because
      -- zipScope assumes all NameSpaces to be present and in the same order.
  , scopeImports :: Map QName ModuleName
scopeImports        = Map QName ModuleName
forall k a. Map k a
Map.empty
  , scopeDatatypeModule :: Maybe DataOrRecordModule
scopeDatatypeModule = Maybe DataOrRecordModule
forall a. Maybe a
Nothing
  }

-- | The empty scope info.
emptyScopeInfo :: ScopeInfo
emptyScopeInfo :: ScopeInfo
emptyScopeInfo = ScopeInfo
  { _scopeCurrent :: ModuleName
_scopeCurrent       = ModuleName
noModuleName
  , _scopeModules :: Map ModuleName Scope
_scopeModules       = ModuleName -> Scope -> Map ModuleName Scope
forall k a. k -> a -> Map k a
Map.singleton ModuleName
noModuleName Scope
emptyScope
  , _scopeVarsToBind :: LocalVars
_scopeVarsToBind    = []
  , _scopeLocals :: LocalVars
_scopeLocals        = []
  , _scopePrecedence :: PrecedenceStack
_scopePrecedence    = []
  , _scopeInverseName :: NameMap
_scopeInverseName   = NameMap
forall k a. Map k a
Map.empty
  , _scopeInverseModule :: ModuleMap
_scopeInverseModule = ModuleMap
forall k a. Map k a
Map.empty
  , _scopeInScope :: InScopeSet
_scopeInScope       = InScopeSet
forall a. Set a
Set.empty
  , _scopeFixities :: Fixities
_scopeFixities      = Fixities
forall k a. Map k a
Map.empty
  , _scopePolarities :: Polarities
_scopePolarities    = Polarities
forall k a. Map k a
Map.empty
  }

-- | Map functions over the names and modules in a scope.
mapScope :: (NameSpaceId -> NamesInScope   -> NamesInScope  ) ->
            (NameSpaceId -> ModulesInScope -> ModulesInScope) ->
            (NameSpaceId -> InScopeSet    -> InScopeSet     ) ->
            Scope -> Scope
mapScope :: (NameSpaceId -> NamesInScope -> NamesInScope)
-> (NameSpaceId -> ModulesInScope -> ModulesInScope)
-> (NameSpaceId -> InScopeSet -> InScopeSet)
-> Scope
-> Scope
mapScope NameSpaceId -> NamesInScope -> NamesInScope
fd NameSpaceId -> ModulesInScope -> ModulesInScope
fm NameSpaceId -> InScopeSet -> InScopeSet
fs = (ScopeNameSpaces -> ScopeNameSpaces) -> Scope -> Scope
updateScopeNameSpaces ((ScopeNameSpaces -> ScopeNameSpaces) -> Scope -> Scope)
-> (ScopeNameSpaces -> ScopeNameSpaces) -> Scope -> Scope
forall a b. (a -> b) -> a -> b
$ (NameSpaceId -> NameSpace -> NameSpace)
-> ScopeNameSpaces -> ScopeNameSpaces
forall k v. (k -> v -> v) -> AssocList k v -> AssocList k v
AssocList.mapWithKey NameSpaceId -> NameSpace -> NameSpace
mapNS
  where
    mapNS :: NameSpaceId -> NameSpace -> NameSpace
mapNS NameSpaceId
acc = (NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet)
-> NameSpace
-> NameSpace
mapNameSpace (NameSpaceId -> NamesInScope -> NamesInScope
fd NameSpaceId
acc) (NameSpaceId -> ModulesInScope -> ModulesInScope
fm NameSpaceId
acc) (NameSpaceId -> InScopeSet -> InScopeSet
fs NameSpaceId
acc)

-- | Same as 'mapScope' but applies the same function to all name spaces.
mapScope_ :: (NamesInScope   -> NamesInScope  ) ->
             (ModulesInScope -> ModulesInScope) ->
             (InScopeSet     -> InScopeSet    ) ->
             Scope -> Scope
mapScope_ :: (NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet)
-> Scope
-> Scope
mapScope_ NamesInScope -> NamesInScope
fd ModulesInScope -> ModulesInScope
fm InScopeSet -> InScopeSet
fs = (NameSpaceId -> NamesInScope -> NamesInScope)
-> (NameSpaceId -> ModulesInScope -> ModulesInScope)
-> (NameSpaceId -> InScopeSet -> InScopeSet)
-> Scope
-> Scope
mapScope ((NamesInScope -> NamesInScope)
-> NameSpaceId -> NamesInScope -> NamesInScope
forall a b. a -> b -> a
const NamesInScope -> NamesInScope
fd) ((ModulesInScope -> ModulesInScope)
-> NameSpaceId -> ModulesInScope -> ModulesInScope
forall a b. a -> b -> a
const ModulesInScope -> ModulesInScope
fm) ((InScopeSet -> InScopeSet)
-> NameSpaceId -> InScopeSet -> InScopeSet
forall a b. a -> b -> a
const InScopeSet -> InScopeSet
fs)

-- | Same as 'mapScope' but applies the function only on the given name space.
mapScopeNS :: NameSpaceId
           -> (NamesInScope   -> NamesInScope  )
           -> (ModulesInScope -> ModulesInScope)
           -> (InScopeSet    -> InScopeSet     )
           -> Scope -> Scope
mapScopeNS :: NameSpaceId
-> (NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet)
-> Scope
-> Scope
mapScopeNS NameSpaceId
nsid NamesInScope -> NamesInScope
fd ModulesInScope -> ModulesInScope
fm InScopeSet -> InScopeSet
fs = NameSpaceId -> (NameSpace -> NameSpace) -> Scope -> Scope
modifyNameSpace NameSpaceId
nsid ((NameSpace -> NameSpace) -> Scope -> Scope)
-> (NameSpace -> NameSpace) -> Scope -> Scope
forall a b. (a -> b) -> a -> b
$ (NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet)
-> NameSpace
-> NameSpace
mapNameSpace NamesInScope -> NamesInScope
fd ModulesInScope -> ModulesInScope
fm InScopeSet -> InScopeSet
fs

-- | Map monadic functions over the names and modules in a scope.
mapScopeM :: Applicative m =>
  (NameSpaceId -> NamesInScope   -> m NamesInScope  ) ->
  (NameSpaceId -> ModulesInScope -> m ModulesInScope) ->
  (NameSpaceId -> InScopeSet     -> m InScopeSet    ) ->
  Scope -> m Scope
mapScopeM :: forall (m :: * -> *).
Applicative m =>
(NameSpaceId -> NamesInScope -> m NamesInScope)
-> (NameSpaceId -> ModulesInScope -> m ModulesInScope)
-> (NameSpaceId -> InScopeSet -> m InScopeSet)
-> Scope
-> m Scope
mapScopeM NameSpaceId -> NamesInScope -> m NamesInScope
fd NameSpaceId -> ModulesInScope -> m ModulesInScope
fm NameSpaceId -> InScopeSet -> m InScopeSet
fs = (ScopeNameSpaces -> m ScopeNameSpaces) -> Scope -> m Scope
forall (m :: * -> *).
Functor m =>
(ScopeNameSpaces -> m ScopeNameSpaces) -> Scope -> m Scope
updateScopeNameSpacesM ((ScopeNameSpaces -> m ScopeNameSpaces) -> Scope -> m Scope)
-> (ScopeNameSpaces -> m ScopeNameSpaces) -> Scope -> m Scope
forall a b. (a -> b) -> a -> b
$ (NameSpaceId -> NameSpace -> m NameSpace)
-> ScopeNameSpaces -> m ScopeNameSpaces
forall (m :: * -> *) k v.
Applicative m =>
(k -> v -> m v) -> AssocList k v -> m (AssocList k v)
AssocList.mapWithKeyM NameSpaceId -> NameSpace -> m NameSpace
mapNS
  where
    mapNS :: NameSpaceId -> NameSpace -> m NameSpace
mapNS NameSpaceId
acc = (NamesInScope -> m NamesInScope)
-> (ModulesInScope -> m ModulesInScope)
-> (InScopeSet -> m InScopeSet)
-> NameSpace
-> m NameSpace
forall (m :: * -> *).
Applicative m =>
(NamesInScope -> m NamesInScope)
-> (ModulesInScope -> m ModulesInScope)
-> (InScopeSet -> m InScopeSet)
-> NameSpace
-> m NameSpace
mapNameSpaceM (NameSpaceId -> NamesInScope -> m NamesInScope
fd NameSpaceId
acc) (NameSpaceId -> ModulesInScope -> m ModulesInScope
fm NameSpaceId
acc) (NameSpaceId -> InScopeSet -> m InScopeSet
fs NameSpaceId
acc)

-- | Same as 'mapScopeM' but applies the same function to both the public and
--   private name spaces.
mapScopeM_ :: Applicative m =>
  (NamesInScope   -> m NamesInScope  ) ->
  (ModulesInScope -> m ModulesInScope) ->
  (InScopeSet     -> m InScopeSet    ) ->
  Scope -> m Scope
mapScopeM_ :: forall (m :: * -> *).
Applicative m =>
(NamesInScope -> m NamesInScope)
-> (ModulesInScope -> m ModulesInScope)
-> (InScopeSet -> m InScopeSet)
-> Scope
-> m Scope
mapScopeM_ NamesInScope -> m NamesInScope
fd ModulesInScope -> m ModulesInScope
fm InScopeSet -> m InScopeSet
fs = (NameSpaceId -> NamesInScope -> m NamesInScope)
-> (NameSpaceId -> ModulesInScope -> m ModulesInScope)
-> (NameSpaceId -> InScopeSet -> m InScopeSet)
-> Scope
-> m Scope
forall (m :: * -> *).
Applicative m =>
(NameSpaceId -> NamesInScope -> m NamesInScope)
-> (NameSpaceId -> ModulesInScope -> m ModulesInScope)
-> (NameSpaceId -> InScopeSet -> m InScopeSet)
-> Scope
-> m Scope
mapScopeM ((NamesInScope -> m NamesInScope)
-> NameSpaceId -> NamesInScope -> m NamesInScope
forall a b. a -> b -> a
const NamesInScope -> m NamesInScope
fd) ((ModulesInScope -> m ModulesInScope)
-> NameSpaceId -> ModulesInScope -> m ModulesInScope
forall a b. a -> b -> a
const ModulesInScope -> m ModulesInScope
fm) ((InScopeSet -> m InScopeSet)
-> NameSpaceId -> InScopeSet -> m InScopeSet
forall a b. a -> b -> a
const InScopeSet -> m InScopeSet
fs)

-- | Zip together two scopes. The resulting scope has the same name as the
--   first scope.
zipScope :: (NameSpaceId -> NamesInScope   -> NamesInScope   -> NamesInScope  ) ->
            (NameSpaceId -> ModulesInScope -> ModulesInScope -> ModulesInScope) ->
            (NameSpaceId -> InScopeSet     -> InScopeSet     -> InScopeSet    ) ->
            Scope -> Scope -> Scope
zipScope :: (NameSpaceId -> NamesInScope -> NamesInScope -> NamesInScope)
-> (NameSpaceId
    -> ModulesInScope -> ModulesInScope -> ModulesInScope)
-> (NameSpaceId -> InScopeSet -> InScopeSet -> InScopeSet)
-> Scope
-> Scope
-> Scope
zipScope NameSpaceId -> NamesInScope -> NamesInScope -> NamesInScope
fd NameSpaceId -> ModulesInScope -> ModulesInScope -> ModulesInScope
fm NameSpaceId -> InScopeSet -> InScopeSet -> InScopeSet
fs Scope
s1 Scope
s2 =
  Scope
s1 { scopeNameSpaces :: ScopeNameSpaces
scopeNameSpaces =
         [ (NameSpaceId
nsid, NameSpaceId -> NameSpace -> NameSpace -> NameSpace
zipNS NameSpaceId
nsid NameSpace
ns1 NameSpace
ns2)
         | ((NameSpaceId
nsid, NameSpace
ns1), (NameSpaceId
nsid', NameSpace
ns2)) <-
             [((NameSpaceId, NameSpace), (NameSpaceId, NameSpace))]
-> Maybe [((NameSpaceId, NameSpace), (NameSpaceId, NameSpace))]
-> [((NameSpaceId, NameSpace), (NameSpaceId, NameSpace))]
forall a. a -> Maybe a -> a
fromMaybe [((NameSpaceId, NameSpace), (NameSpaceId, NameSpace))]
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe [((NameSpaceId, NameSpace), (NameSpaceId, NameSpace))]
 -> [((NameSpaceId, NameSpace), (NameSpaceId, NameSpace))])
-> Maybe [((NameSpaceId, NameSpace), (NameSpaceId, NameSpace))]
-> [((NameSpaceId, NameSpace), (NameSpaceId, NameSpace))]
forall a b. (a -> b) -> a -> b
$
               ((NameSpaceId, NameSpace)
 -> (NameSpaceId, NameSpace)
 -> ((NameSpaceId, NameSpace), (NameSpaceId, NameSpace)))
-> ScopeNameSpaces
-> ScopeNameSpaces
-> Maybe [((NameSpaceId, NameSpace), (NameSpaceId, NameSpace))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> Maybe [c]
zipWith' (,) (Scope -> ScopeNameSpaces
scopeNameSpaces Scope
s1) (Scope -> ScopeNameSpaces
scopeNameSpaces Scope
s2)
         , Bool -> Bool
assert (NameSpaceId
nsid NameSpaceId -> NameSpaceId -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpaceId
nsid')
         ]
     , scopeImports :: Map QName ModuleName
scopeImports  = (Map QName ModuleName
-> Map QName ModuleName -> Map QName ModuleName
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (Map QName ModuleName
 -> Map QName ModuleName -> Map QName ModuleName)
-> (Scope -> Map QName ModuleName)
-> Scope
-> Scope
-> Map QName ModuleName
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Scope -> Map QName ModuleName
scopeImports)  Scope
s1 Scope
s2
     }
  where
    assert :: Bool -> Bool
assert Bool
True  = Bool
True
    assert Bool
False = Bool
forall a. HasCallStack => a
__IMPOSSIBLE__
    zipNS :: NameSpaceId -> NameSpace -> NameSpace -> NameSpace
zipNS NameSpaceId
acc = (NamesInScope -> NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet -> InScopeSet)
-> NameSpace
-> NameSpace
-> NameSpace
zipNameSpace (NameSpaceId -> NamesInScope -> NamesInScope -> NamesInScope
fd NameSpaceId
acc) (NameSpaceId -> ModulesInScope -> ModulesInScope -> ModulesInScope
fm NameSpaceId
acc) (NameSpaceId -> InScopeSet -> InScopeSet -> InScopeSet
fs NameSpaceId
acc)

-- | Same as 'zipScope' but applies the same function to both the public and
--   private name spaces.
zipScope_ :: (NamesInScope   -> NamesInScope   -> NamesInScope  ) ->
             (ModulesInScope -> ModulesInScope -> ModulesInScope) ->
             (InScopeSet     -> InScopeSet     -> InScopeSet    ) ->
             Scope -> Scope -> Scope
zipScope_ :: (NamesInScope -> NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet -> InScopeSet)
-> Scope
-> Scope
-> Scope
zipScope_ NamesInScope -> NamesInScope -> NamesInScope
fd ModulesInScope -> ModulesInScope -> ModulesInScope
fm InScopeSet -> InScopeSet -> InScopeSet
fs = (NameSpaceId -> NamesInScope -> NamesInScope -> NamesInScope)
-> (NameSpaceId
    -> ModulesInScope -> ModulesInScope -> ModulesInScope)
-> (NameSpaceId -> InScopeSet -> InScopeSet -> InScopeSet)
-> Scope
-> Scope
-> Scope
zipScope ((NamesInScope -> NamesInScope -> NamesInScope)
-> NameSpaceId -> NamesInScope -> NamesInScope -> NamesInScope
forall a b. a -> b -> a
const NamesInScope -> NamesInScope -> NamesInScope
fd) ((ModulesInScope -> ModulesInScope -> ModulesInScope)
-> NameSpaceId
-> ModulesInScope
-> ModulesInScope
-> ModulesInScope
forall a b. a -> b -> a
const ModulesInScope -> ModulesInScope -> ModulesInScope
fm) ((InScopeSet -> InScopeSet -> InScopeSet)
-> NameSpaceId -> InScopeSet -> InScopeSet -> InScopeSet
forall a b. a -> b -> a
const InScopeSet -> InScopeSet -> InScopeSet
fs)

-- | Recompute the inScope sets of a scope.
recomputeInScopeSets :: Scope -> Scope
recomputeInScopeSets :: Scope -> Scope
recomputeInScopeSets = (ScopeNameSpaces -> ScopeNameSpaces) -> Scope -> Scope
updateScopeNameSpaces (((NameSpaceId, NameSpace) -> (NameSpaceId, NameSpace))
-> ScopeNameSpaces -> ScopeNameSpaces
forall a b. (a -> b) -> [a] -> [b]
map (((NameSpaceId, NameSpace) -> (NameSpaceId, NameSpace))
 -> ScopeNameSpaces -> ScopeNameSpaces)
-> ((NameSpaceId, NameSpace) -> (NameSpaceId, NameSpace))
-> ScopeNameSpaces
-> ScopeNameSpaces
forall a b. (a -> b) -> a -> b
$ (NameSpace -> NameSpace)
-> (NameSpaceId, NameSpace) -> (NameSpaceId, NameSpace)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second NameSpace -> NameSpace
recomputeInScope)
  where
    recomputeInScope :: NameSpace -> NameSpace
recomputeInScope NameSpace
ns = NameSpace
ns { nsInScope :: InScopeSet
nsInScope = NamesInScope -> InScopeSet
allANames (NamesInScope -> InScopeSet) -> NamesInScope -> InScopeSet
forall a b. (a -> b) -> a -> b
$ NameSpace -> NamesInScope
nsNames NameSpace
ns }
    allANames :: NamesInScope -> InScopeSet
    allANames :: NamesInScope -> InScopeSet
allANames = [QName] -> InScopeSet
forall a. Ord a => [a] -> Set a
Set.fromList ([QName] -> InScopeSet)
-> (NamesInScope -> [QName]) -> NamesInScope -> InScopeSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbstractName -> QName) -> [AbstractName] -> [QName]
forall a b. (a -> b) -> [a] -> [b]
map AbstractName -> QName
anameName ([AbstractName] -> [QName])
-> (NamesInScope -> [AbstractName]) -> NamesInScope -> [QName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[AbstractName]] -> [AbstractName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[AbstractName]] -> [AbstractName])
-> (NamesInScope -> [[AbstractName]])
-> NamesInScope
-> [AbstractName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamesInScope -> [[AbstractName]]
forall k a. Map k a -> [a]
Map.elems

-- | Filter a scope keeping only concrete names matching the predicates.
--   The first predicate is applied to the names and the second to the modules.
filterScope :: (C.Name -> Bool) -> (C.Name -> Bool) -> Scope -> Scope
filterScope :: (Name -> Bool) -> (Name -> Bool) -> Scope -> Scope
filterScope Name -> Bool
pd Name -> Bool
pm = Scope -> Scope
recomputeInScopeSets (Scope -> Scope) -> (Scope -> Scope) -> Scope -> Scope
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet)
-> Scope
-> Scope
mapScope_ ((Name -> Bool) -> NamesInScope -> NamesInScope
forall k a. (k -> Bool) -> Map k a -> Map k a
Map.filterKeys Name -> Bool
pd) ((Name -> Bool) -> ModulesInScope -> ModulesInScope
forall k a. (k -> Bool) -> Map k a -> Map k a
Map.filterKeys Name -> Bool
pm) InScopeSet -> InScopeSet
forall a. a -> a
id
  -- We don't have enough information in the in scope set to do an
  -- incremental update here, so just recompute it from the name map.

-- | Return all names in a scope.
allNamesInScope :: InScope a => Scope -> ThingsInScope a
allNamesInScope :: forall a. InScope a => Scope -> ThingsInScope a
allNamesInScope = [ThingsInScope a] -> ThingsInScope a
forall a. Eq a => [ThingsInScope a] -> ThingsInScope a
mergeNamesMany ([ThingsInScope a] -> ThingsInScope a)
-> (Scope -> [ThingsInScope a]) -> Scope -> ThingsInScope a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NameSpaceId, NameSpace) -> ThingsInScope a)
-> ScopeNameSpaces -> [ThingsInScope a]
forall a b. (a -> b) -> [a] -> [b]
map (NameSpace -> ThingsInScope a
forall a. InScope a => NameSpace -> ThingsInScope a
inNameSpace (NameSpace -> ThingsInScope a)
-> ((NameSpaceId, NameSpace) -> NameSpace)
-> (NameSpaceId, NameSpace)
-> ThingsInScope a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameSpaceId, NameSpace) -> NameSpace
forall a b. (a, b) -> b
snd) (ScopeNameSpaces -> [ThingsInScope a])
-> (Scope -> ScopeNameSpaces) -> Scope -> [ThingsInScope a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope -> ScopeNameSpaces
scopeNameSpaces

allNamesInScope' :: InScope a => Scope -> ThingsInScope (a, Access)
allNamesInScope' :: forall a. InScope a => Scope -> ThingsInScope (a, Access)
allNamesInScope' Scope
s =
  [ThingsInScope (a, Access)] -> ThingsInScope (a, Access)
forall a. Eq a => [ThingsInScope a] -> ThingsInScope a
mergeNamesMany [ (a -> (a, Access)) -> [a] -> [(a, Access)]
forall a b. (a -> b) -> [a] -> [b]
map (, NameSpaceId -> Access
nameSpaceAccess NameSpaceId
nsId) ([a] -> [(a, Access)]) -> Map Name [a] -> ThingsInScope (a, Access)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NameSpace -> Map Name [a]
forall a. InScope a => NameSpace -> ThingsInScope a
inNameSpace NameSpace
ns
                 | (NameSpaceId
nsId, NameSpace
ns) <- Scope -> ScopeNameSpaces
scopeNameSpaces Scope
s ]

-- | Look up a single name in the current scope.
--
-- This is equivalent to @Map.lookup n . allNamesInScope'@, but more efficient
-- when only a single name needs to be looked up.
findNameInScope :: InScope a => C.Name -> Scope -> [(a, Access)]
findNameInScope :: forall a. InScope a => Name -> Scope -> [(a, Access)]
findNameInScope Name
n Scope
s =
  [ (a
name, NameSpaceId -> Access
nameSpaceAccess NameSpaceId
nsId)
  | (NameSpaceId
nsId, NameSpace
ns) <- Scope -> ScopeNameSpaces
scopeNameSpaces Scope
s
  , a
name <- [a] -> Name -> Map Name [a] -> [a]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Name
n (Map Name [a] -> [a]) -> Map Name [a] -> [a]
forall a b. (a -> b) -> a -> b
$ NameSpace -> Map Name [a]
forall a. InScope a => NameSpace -> ThingsInScope a
inNameSpace NameSpace
ns ]

-- | Returns the scope's non-private names.
exportedNamesInScope :: InScope a => Scope -> ThingsInScope a
exportedNamesInScope :: forall a. InScope a => Scope -> ThingsInScope a
exportedNamesInScope = [NameSpaceId] -> Scope -> ThingsInScope a
forall a. InScope a => [NameSpaceId] -> Scope -> ThingsInScope a
namesInScope [NameSpaceId
PublicNS, NameSpaceId
ImportedNS]

namesInScope :: InScope a => [NameSpaceId] -> Scope -> ThingsInScope a
namesInScope :: forall a. InScope a => [NameSpaceId] -> Scope -> ThingsInScope a
namesInScope [NameSpaceId]
ids Scope
s =
  [ThingsInScope a] -> ThingsInScope a
forall a. Eq a => [ThingsInScope a] -> ThingsInScope a
mergeNamesMany [ NameSpace -> ThingsInScope a
forall a. InScope a => NameSpace -> ThingsInScope a
inNameSpace (NameSpaceId -> Scope -> NameSpace
scopeNameSpace NameSpaceId
nsid Scope
s) | NameSpaceId
nsid <- [NameSpaceId]
ids ]

allThingsInScope :: Scope -> NameSpace
allThingsInScope :: Scope -> NameSpace
allThingsInScope Scope
s =
  NameSpace { nsNames :: NamesInScope
nsNames   = Scope -> NamesInScope
forall a. InScope a => Scope -> ThingsInScope a
allNamesInScope Scope
s
            , nsModules :: ModulesInScope
nsModules = Scope -> ModulesInScope
forall a. InScope a => Scope -> ThingsInScope a
allNamesInScope Scope
s
            , nsInScope :: InScopeSet
nsInScope = [InScopeSet] -> InScopeSet
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([InScopeSet] -> InScopeSet) -> [InScopeSet] -> InScopeSet
forall a b. (a -> b) -> a -> b
$ ((NameSpaceId, NameSpace) -> InScopeSet)
-> ScopeNameSpaces -> [InScopeSet]
forall a b. (a -> b) -> [a] -> [b]
map (NameSpace -> InScopeSet
nsInScope (NameSpace -> InScopeSet)
-> ((NameSpaceId, NameSpace) -> NameSpace)
-> (NameSpaceId, NameSpace)
-> InScopeSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameSpaceId, NameSpace) -> NameSpace
forall a b. (a, b) -> b
snd) (ScopeNameSpaces -> [InScopeSet])
-> ScopeNameSpaces -> [InScopeSet]
forall a b. (a -> b) -> a -> b
$ Scope -> ScopeNameSpaces
scopeNameSpaces Scope
s
            }

thingsInScope :: [NameSpaceId] -> Scope -> NameSpace
thingsInScope :: [NameSpaceId] -> Scope -> NameSpace
thingsInScope [NameSpaceId]
fs Scope
s =
  NameSpace { nsNames :: NamesInScope
nsNames   = [NameSpaceId] -> Scope -> NamesInScope
forall a. InScope a => [NameSpaceId] -> Scope -> ThingsInScope a
namesInScope [NameSpaceId]
fs Scope
s
            , nsModules :: ModulesInScope
nsModules = [NameSpaceId] -> Scope -> ModulesInScope
forall a. InScope a => [NameSpaceId] -> Scope -> ThingsInScope a
namesInScope [NameSpaceId]
fs Scope
s
            , nsInScope :: InScopeSet
nsInScope = [InScopeSet] -> InScopeSet
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [ NameSpace -> InScopeSet
nsInScope (NameSpace -> InScopeSet) -> NameSpace -> InScopeSet
forall a b. (a -> b) -> a -> b
$ NameSpaceId -> Scope -> NameSpace
scopeNameSpace NameSpaceId
nsid Scope
s | NameSpaceId
nsid <- [NameSpaceId]
fs ]
            }

-- | Merge two scopes. The result has the name of the first scope.
mergeScope :: Scope -> Scope -> Scope
mergeScope :: Scope -> Scope -> Scope
mergeScope = (NamesInScope -> NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet -> InScopeSet)
-> Scope
-> Scope
-> Scope
zipScope_ NamesInScope -> NamesInScope -> NamesInScope
forall a.
Eq a =>
ThingsInScope a -> ThingsInScope a -> ThingsInScope a
mergeNames ModulesInScope -> ModulesInScope -> ModulesInScope
forall a.
Eq a =>
ThingsInScope a -> ThingsInScope a -> ThingsInScope a
mergeNames InScopeSet -> InScopeSet -> InScopeSet
forall a. Ord a => Set a -> Set a -> Set a
Set.union

-- | Merge a non-empty list of scopes. The result has the name of the first
--   scope in the list.
mergeScopes :: [Scope] -> Scope
mergeScopes :: [Scope] -> Scope
mergeScopes [] = Scope
forall a. HasCallStack => a
__IMPOSSIBLE__
mergeScopes [Scope]
ss = (Scope -> Scope -> Scope) -> [Scope] -> Scope
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Scope -> Scope -> Scope
mergeScope [Scope]
ss

-- * Specific operations on scopes

-- | Move all names in a scope to the given name space (except never move from
--   Imported to Public).
setScopeAccess :: NameSpaceId -> Scope -> Scope
setScopeAccess :: NameSpaceId -> Scope -> Scope
setScopeAccess NameSpaceId
a Scope
s = ((ScopeNameSpaces -> ScopeNameSpaces) -> Scope -> Scope
`updateScopeNameSpaces` Scope
s) ((ScopeNameSpaces -> ScopeNameSpaces) -> Scope)
-> (ScopeNameSpaces -> ScopeNameSpaces) -> Scope
forall a b. (a -> b) -> a -> b
$ (NameSpaceId -> NameSpace -> NameSpace)
-> ScopeNameSpaces -> ScopeNameSpaces
forall k v. (k -> v -> v) -> AssocList k v -> AssocList k v
AssocList.mapWithKey ((NameSpaceId -> NameSpace -> NameSpace)
 -> ScopeNameSpaces -> ScopeNameSpaces)
-> (NameSpaceId -> NameSpace -> NameSpace)
-> ScopeNameSpaces
-> ScopeNameSpaces
forall a b. (a -> b) -> a -> b
$ NameSpace -> NameSpace -> NameSpace
forall a b. a -> b -> a
const (NameSpace -> NameSpace -> NameSpace)
-> (NameSpaceId -> NameSpace)
-> NameSpaceId
-> NameSpace
-> NameSpace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSpaceId -> NameSpace
ns
  where
    zero :: NameSpace
zero  = NameSpace
emptyNameSpace
    one :: NameSpace
one   = Scope -> NameSpace
allThingsInScope Scope
s
    imp :: NameSpace
imp   = [NameSpaceId] -> Scope -> NameSpace
thingsInScope [NameSpaceId
ImportedNS] Scope
s
    noimp :: NameSpace
noimp = [NameSpaceId] -> Scope -> NameSpace
thingsInScope [NameSpaceId
PublicNS, NameSpaceId
PrivateNS] Scope
s

    ns :: NameSpaceId -> NameSpace
ns NameSpaceId
b = case (NameSpaceId
a, NameSpaceId
b) of
      (NameSpaceId
PublicNS, NameSpaceId
PublicNS)   -> NameSpace
noimp
      (NameSpaceId
PublicNS, NameSpaceId
ImportedNS) -> NameSpace
imp
      (NameSpaceId, NameSpaceId)
_ | NameSpaceId
a NameSpaceId -> NameSpaceId -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpaceId
b             -> NameSpace
one
        | Bool
otherwise          -> NameSpace
zero

-- | Update a particular name space.
setNameSpace :: NameSpaceId -> NameSpace -> Scope -> Scope
setNameSpace :: NameSpaceId -> NameSpace -> Scope -> Scope
setNameSpace NameSpaceId
nsid NameSpace
ns = NameSpaceId -> (NameSpace -> NameSpace) -> Scope -> Scope
modifyNameSpace NameSpaceId
nsid ((NameSpace -> NameSpace) -> Scope -> Scope)
-> (NameSpace -> NameSpace) -> Scope -> Scope
forall a b. (a -> b) -> a -> b
$ NameSpace -> NameSpace -> NameSpace
forall a b. a -> b -> a
const NameSpace
ns

-- | Modify a particular name space.
modifyNameSpace :: NameSpaceId -> (NameSpace -> NameSpace) -> Scope -> Scope
modifyNameSpace :: NameSpaceId -> (NameSpace -> NameSpace) -> Scope -> Scope
modifyNameSpace NameSpaceId
nsid NameSpace -> NameSpace
f = (ScopeNameSpaces -> ScopeNameSpaces) -> Scope -> Scope
updateScopeNameSpaces ((ScopeNameSpaces -> ScopeNameSpaces) -> Scope -> Scope)
-> (ScopeNameSpaces -> ScopeNameSpaces) -> Scope -> Scope
forall a b. (a -> b) -> a -> b
$ NameSpaceId
-> (NameSpace -> NameSpace) -> ScopeNameSpaces -> ScopeNameSpaces
forall k v. Eq k => k -> (v -> v) -> AssocList k v -> AssocList k v
AssocList.updateAt NameSpaceId
nsid NameSpace -> NameSpace
f

-- | Add a name to a scope.
addNameToScope :: NameSpaceId -> C.Name -> AbstractName -> Scope -> Scope
addNameToScope :: NameSpaceId -> Name -> AbstractName -> Scope -> Scope
addNameToScope NameSpaceId
nsid Name
x AbstractName
y =
  NameSpaceId
-> (NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet)
-> Scope
-> Scope
mapScopeNS NameSpaceId
nsid
    (([AbstractName] -> [AbstractName] -> [AbstractName])
-> Name -> [AbstractName] -> NamesInScope -> NamesInScope
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (([AbstractName] -> [AbstractName] -> [AbstractName])
-> [AbstractName] -> [AbstractName] -> [AbstractName]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [AbstractName] -> [AbstractName] -> [AbstractName]
forall a. Eq a => [a] -> [a] -> [a]
List.union) Name
x [AbstractName
y])  -- bind name x ↦ y
    ModulesInScope -> ModulesInScope
forall a. a -> a
id                                        -- no change to modules
    (QName -> InScopeSet -> InScopeSet
forall a. Ord a => a -> Set a -> Set a
Set.insert (QName -> InScopeSet -> InScopeSet)
-> QName -> InScopeSet -> InScopeSet
forall a b. (a -> b) -> a -> b
$ AbstractName -> QName
anameName AbstractName
y)                -- y is in scope now

-- | Remove a name from a scope. Caution: does not update the nsInScope set.
--   This is only used by rebindName and in that case we add the name right
--   back (but with a different kind).
removeNameFromScope :: NameSpaceId -> C.Name -> Scope -> Scope
removeNameFromScope :: NameSpaceId -> Name -> Scope -> Scope
removeNameFromScope NameSpaceId
nsid Name
x = NameSpaceId
-> (NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet)
-> Scope
-> Scope
mapScopeNS NameSpaceId
nsid (Name -> NamesInScope -> NamesInScope
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Name
x) ModulesInScope -> ModulesInScope
forall a. a -> a
id InScopeSet -> InScopeSet
forall a. a -> a
id

-- | Add a module to a scope.
addModuleToScope :: NameSpaceId -> C.Name -> AbstractModule -> Scope -> Scope
addModuleToScope :: NameSpaceId -> Name -> AbstractModule -> Scope -> Scope
addModuleToScope NameSpaceId
nsid Name
x AbstractModule
m = NameSpaceId
-> (NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet)
-> Scope
-> Scope
mapScopeNS NameSpaceId
nsid NamesInScope -> NamesInScope
forall a. a -> a
id ModulesInScope -> ModulesInScope
addM InScopeSet -> InScopeSet
forall a. a -> a
id
  where addM :: ModulesInScope -> ModulesInScope
addM = ([AbstractModule] -> [AbstractModule] -> [AbstractModule])
-> Name -> [AbstractModule] -> ModulesInScope -> ModulesInScope
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (([AbstractModule] -> [AbstractModule] -> [AbstractModule])
-> [AbstractModule] -> [AbstractModule] -> [AbstractModule]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [AbstractModule] -> [AbstractModule] -> [AbstractModule]
forall a. Eq a => [a] -> [a] -> [a]
List.union) Name
x [AbstractModule
m]

-- | When we get here we cannot have both @using@ and @hiding@.
data UsingOrHiding
  = UsingOnly  [C.ImportedName]
  | HidingOnly [C.ImportedName]

usingOrHiding :: C.ImportDirective -> UsingOrHiding
usingOrHiding :: ImportDirective -> UsingOrHiding
usingOrHiding ImportDirective
i =
  case (ImportDirective -> Using' Name Name
forall n m. ImportDirective' n m -> Using' n m
using ImportDirective
i, ImportDirective -> HidingDirective' Name Name
forall n m. ImportDirective' n m -> HidingDirective' n m
hiding ImportDirective
i) of
    (Using' Name Name
UseEverything, HidingDirective' Name Name
ys) -> HidingDirective' Name Name -> UsingOrHiding
HidingOnly HidingDirective' Name Name
ys
    (Using HidingDirective' Name Name
xs     , []) -> HidingDirective' Name Name -> UsingOrHiding
UsingOnly  HidingDirective' Name Name
xs
    (Using' Name Name, HidingDirective' Name Name)
_                   -> UsingOrHiding
forall a. HasCallStack => a
__IMPOSSIBLE__

-- | Apply an 'ImportDirective' to a scope:
--
--   1. rename keys (C.Name) according to @renaming@;
--
--   2. for untouched keys, either of
--
--      a) remove keys according to @hiding@, or
--      b) filter keys according to @using@.
--
--   Both steps could be done in one pass, by first preparing key-filtering
--   functions @C.Name -> Maybe C.Name@ for defined names and module names.
--   However, the penalty of doing it in two passes should not be too high.
--   (Doubling the run time.)
applyImportDirective :: C.ImportDirective -> Scope -> Scope
applyImportDirective :: ImportDirective -> Scope -> Scope
applyImportDirective ImportDirective
dir = (Scope, (Set Name, Set Name)) -> Scope
forall a b. (a, b) -> a
fst ((Scope, (Set Name, Set Name)) -> Scope)
-> (Scope -> (Scope, (Set Name, Set Name))) -> Scope -> Scope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDirective -> Scope -> (Scope, (Set Name, Set Name))
applyImportDirective_ ImportDirective
dir

-- | Version of 'applyImportDirective' that also returns sets of name
--   and module name clashes introduced by @renaming@ to identifiers
--   that are already imported by @using@ or lack of @hiding@.
applyImportDirective_
  :: C.ImportDirective
  -> Scope
  -> (Scope, (Set C.Name, Set C.Name)) -- ^ Merged scope, clashing names, clashing module names.
applyImportDirective_ :: ImportDirective -> Scope -> (Scope, (Set Name, Set Name))
applyImportDirective_ dir :: ImportDirective
dir@(ImportDirective{ RenamingDirective' Name Name
impRenaming :: RenamingDirective' Name Name
impRenaming :: forall n m. ImportDirective' n m -> RenamingDirective' n m
impRenaming }) Scope
s
  | ImportDirective -> Bool
forall a. Null a => a -> Bool
null ImportDirective
dir  = (Scope
s, (Set Name
forall a. Null a => a
empty, Set Name
forall a. Null a => a
empty))
      -- Since each run of applyImportDirective rebuilds the scope
      -- with cost O(n log n) time, it makes sense to test for the identity.
  | Bool
otherwise = (Scope -> Scope
recomputeInScopeSets (Scope -> Scope) -> Scope -> Scope
forall a b. (a -> b) -> a -> b
$ Scope -> Scope -> Scope
mergeScope Scope
sUse Scope
sRen, (Set Name
nameClashes, Set Name
moduleClashes))
  where
    -- Names kept via using/hiding.
    sUse :: Scope
    sUse :: Scope
sUse = UsingOrHiding -> Scope -> Scope
useOrHide (ImportDirective -> UsingOrHiding
usingOrHiding ImportDirective
dir) Scope
s

    -- Things kept (under a different name) via renaming.
    sRen :: Scope
    sRen :: Scope
sRen = RenamingDirective' Name Name -> Scope -> Scope
rename RenamingDirective' Name Name
impRenaming Scope
s

    -- Which names are considered to be defined by a module?
    -- The ones actually defined there publicly ('publicNS')
    -- and the ones imported publicly ('ImportedNS')?
    exportedNSs :: [NameSpaceId]
exportedNSs = [NameSpaceId
PublicNS, NameSpaceId
ImportedNS]

    -- Name clashes introduced by the @renaming@ clause.
    nameClashes :: Set C.Name
    nameClashes :: Set Name
nameClashes = NamesInScope -> Set Name
forall k a. Map k a -> Set k
Map.keysSet NamesInScope
rNames Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` NamesInScope -> Set Name
forall k a. Map k a -> Set k
Map.keysSet NamesInScope
uNames
      -- NB: `intersection` returns a subset of the first argument.
      -- To get the correct error location, i.e., in the @renaming@ clause
      -- rather than at the definition location, we neet to return
      -- names from the @renaming@ clause.  (Issue #4154.)
      where
      uNames, rNames :: NamesInScope
      uNames :: NamesInScope
uNames = [NameSpaceId] -> Scope -> NamesInScope
forall a. InScope a => [NameSpaceId] -> Scope -> ThingsInScope a
namesInScope [NameSpaceId]
exportedNSs Scope
sUse
      rNames :: NamesInScope
rNames = [NameSpaceId] -> Scope -> NamesInScope
forall a. InScope a => [NameSpaceId] -> Scope -> ThingsInScope a
namesInScope [NameSpaceId]
exportedNSs Scope
sRen

    -- Module name clashes introduced by the @renaming@ clause.

    -- Note: need to cut and paste because of 'InScope' dependent types trickery.
    moduleClashes :: Set C.Name
    moduleClashes :: Set Name
moduleClashes = ModulesInScope -> Set Name
forall k a. Map k a -> Set k
Map.keysSet ModulesInScope
uModules Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` ModulesInScope -> Set Name
forall k a. Map k a -> Set k
Map.keysSet ModulesInScope
rModules
      where
      uModules, rModules :: ModulesInScope
      uModules :: ModulesInScope
uModules = [NameSpaceId] -> Scope -> ModulesInScope
forall a. InScope a => [NameSpaceId] -> Scope -> ThingsInScope a
namesInScope [NameSpaceId]
exportedNSs Scope
sUse
      rModules :: ModulesInScope
rModules = [NameSpaceId] -> Scope -> ModulesInScope
forall a. InScope a => [NameSpaceId] -> Scope -> ThingsInScope a
namesInScope [NameSpaceId]
exportedNSs Scope
sRen


    -- Restrict scope by directive.
    useOrHide :: UsingOrHiding -> Scope -> Scope
    useOrHide :: UsingOrHiding -> Scope -> Scope
useOrHide (UsingOnly  HidingDirective' Name Name
xs) = (Name -> Set Name -> Bool)
-> HidingDirective' Name Name -> Scope -> Scope
filterNames Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member HidingDirective' Name Name
xs
       -- Filter scope, keeping only xs.
    useOrHide (HidingOnly HidingDirective' Name Name
xs) = (Name -> Set Name -> Bool)
-> HidingDirective' Name Name -> Scope -> Scope
filterNames Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember (HidingDirective' Name Name -> Scope -> Scope)
-> HidingDirective' Name Name -> Scope -> Scope
forall a b. (a -> b) -> a -> b
$ (Renaming' Name Name -> ImportedName)
-> RenamingDirective' Name Name -> HidingDirective' Name Name
forall a b. (a -> b) -> [a] -> [b]
map Renaming' Name Name -> ImportedName
forall n m. Renaming' n m -> ImportedName' n m
renFrom RenamingDirective' Name Name
impRenaming HidingDirective' Name Name
-> HidingDirective' Name Name -> HidingDirective' Name Name
forall a. [a] -> [a] -> [a]
++ HidingDirective' Name Name
xs
       -- Filter out xs and the to be renamed names from scope.

    -- Filter scope by (`rel` xs).
    -- O(n * log (length xs)).
    filterNames :: (C.Name -> Set C.Name -> Bool) -> [C.ImportedName] ->
                   Scope -> Scope
    filterNames :: (Name -> Set Name -> Bool)
-> HidingDirective' Name Name -> Scope -> Scope
filterNames Name -> Set Name -> Bool
rel HidingDirective' Name Name
xs = (Name -> Bool) -> (Name -> Bool) -> Scope -> Scope
filterScope (Name -> Set Name -> Bool
`rel` [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList [Name]
ds) (Name -> Set Name -> Bool
`rel` [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList [Name]
ms)
      where
        ([Name]
ds, [Name]
ms) = [Either Name Name] -> ([Name], [Name])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either Name Name] -> ([Name], [Name]))
-> [Either Name Name] -> ([Name], [Name])
forall a b. (a -> b) -> a -> b
$ HidingDirective' Name Name
-> (ImportedName -> Either Name Name) -> [Either Name Name]
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
for HidingDirective' Name Name
xs ((ImportedName -> Either Name Name) -> [Either Name Name])
-> (ImportedName -> Either Name Name) -> [Either Name Name]
forall a b. (a -> b) -> a -> b
$ \case
          ImportedName   Name
x -> Name -> Either Name Name
forall a b. a -> Either a b
Left Name
x
          ImportedModule Name
m -> Name -> Either Name Name
forall a b. b -> Either a b
Right Name
m

    -- Apply a renaming to a scope.
    -- O(n * (log n + log (length rho))).
    rename :: [C.Renaming] -> Scope -> Scope
    rename :: RenamingDirective' Name Name -> Scope -> Scope
rename RenamingDirective' Name Name
rho = (NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet)
-> Scope
-> Scope
mapScope_ (NamesInScope -> NamesInScope
updateFxs (NamesInScope -> NamesInScope)
-> (NamesInScope -> NamesInScope) -> NamesInScope -> NamesInScope
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            (Name -> Maybe Name) -> NamesInScope -> NamesInScope
forall a.
SetBindingSite a =>
(Name -> Maybe Name) -> ThingsInScope a -> ThingsInScope a
updateThingsInScope (AssocList Name Name -> Name -> Maybe Name
forall k v. Ord k => AssocList k v -> k -> Maybe v
AssocList.apply AssocList Name Name
drho))
                           ((Name -> Maybe Name) -> ModulesInScope -> ModulesInScope
forall a.
SetBindingSite a =>
(Name -> Maybe Name) -> ThingsInScope a -> ThingsInScope a
updateThingsInScope (AssocList Name Name -> Name -> Maybe Name
forall k v. Ord k => AssocList k v -> k -> Maybe v
AssocList.apply AssocList Name Name
mrho))
                           InScopeSet -> InScopeSet
forall a. a -> a
id
      where
        (AssocList Name Name
drho, AssocList Name Name
mrho) = [Either (Name, Name) (Name, Name)]
-> (AssocList Name Name, AssocList Name Name)
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either (Name, Name) (Name, Name)]
 -> (AssocList Name Name, AssocList Name Name))
-> [Either (Name, Name) (Name, Name)]
-> (AssocList Name Name, AssocList Name Name)
forall a b. (a -> b) -> a -> b
$ RenamingDirective' Name Name
-> (Renaming' Name Name -> Either (Name, Name) (Name, Name))
-> [Either (Name, Name) (Name, Name)]
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
for RenamingDirective' Name Name
rho ((Renaming' Name Name -> Either (Name, Name) (Name, Name))
 -> [Either (Name, Name) (Name, Name)])
-> (Renaming' Name Name -> Either (Name, Name) (Name, Name))
-> [Either (Name, Name) (Name, Name)]
forall a b. (a -> b) -> a -> b
$ \case
          Renaming (ImportedName   Name
x) (ImportedName   Name
y) Maybe Fixity
_fx Range
_ -> (Name, Name) -> Either (Name, Name) (Name, Name)
forall a b. a -> Either a b
Left  (Name
x, Name
y)
          Renaming (ImportedModule Name
x) (ImportedModule Name
y) Maybe Fixity
_fx Range
_ -> (Name, Name) -> Either (Name, Name) (Name, Name)
forall a b. b -> Either a b
Right (Name
x, Name
y)
          Renaming' Name Name
_ -> Either (Name, Name) (Name, Name)
forall a. HasCallStack => a
__IMPOSSIBLE__

        fixities :: AssocList C.Name Fixity
        fixities :: AssocList Name Fixity
fixities = ((Renaming' Name Name -> Maybe (Name, Fixity))
-> RenamingDirective' Name Name -> AssocList Name Fixity
forall a b. (a -> Maybe b) -> [a] -> [b]
`mapMaybe` RenamingDirective' Name Name
rho) ((Renaming' Name Name -> Maybe (Name, Fixity))
 -> AssocList Name Fixity)
-> (Renaming' Name Name -> Maybe (Name, Fixity))
-> AssocList Name Fixity
forall a b. (a -> b) -> a -> b
$ \case
          Renaming ImportedName
_ (ImportedName Name
y) (Just Fixity
fx)  Range
_ -> (Name, Fixity) -> Maybe (Name, Fixity)
forall a. a -> Maybe a
Just (Name
y, Fixity
fx)
          Renaming' Name Name
_ -> Maybe (Name, Fixity)
forall a. Maybe a
Nothing

        -- Update fixities of abstract names targeted by renamed imported identifies.
        updateFxs :: NamesInScope -> NamesInScope
        updateFxs :: NamesInScope -> NamesInScope
updateFxs NamesInScope
m = (NamesInScope -> (Name, Fixity) -> NamesInScope)
-> NamesInScope -> AssocList Name Fixity -> NamesInScope
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl NamesInScope -> (Name, Fixity) -> NamesInScope
forall {k} {a}.
(Ord k, LensFixity a) =>
Map k [a] -> (k, Fixity) -> Map k [a]
upd NamesInScope
m AssocList Name Fixity
fixities
          where
          -- Update fixity of all abstract names targeted by concrete name y.
          upd :: Map k [a] -> (k, Fixity) -> Map k [a]
upd Map k [a]
m (k
y, Fixity
fx) = ([a] -> [a]) -> k -> Map k [a] -> Map k [a]
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> a) -> [a] -> [a]) -> (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Lens' Fixity a -> LensSet Fixity a
forall i o. Lens' i o -> LensSet i o
set (Fixity -> f Fixity) -> a -> f a
forall a. LensFixity a => Lens' Fixity a
Lens' Fixity a
lensFixity Fixity
fx) k
y Map k [a]
m

        updateThingsInScope
          :: forall a. SetBindingSite a
          => (C.Name -> Maybe C.Name)
          -> ThingsInScope a -> ThingsInScope a
        updateThingsInScope :: forall a.
SetBindingSite a =>
(Name -> Maybe Name) -> ThingsInScope a -> ThingsInScope a
updateThingsInScope Name -> Maybe Name
f = ([a] -> [a] -> [a]) -> [(Name, [a])] -> Map Name [a]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [a] -> [a] -> [a]
forall a. HasCallStack => a
__IMPOSSIBLE__ ([(Name, [a])] -> Map Name [a])
-> (Map Name [a] -> [(Name, [a])]) -> Map Name [a] -> Map Name [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, [a]) -> Maybe (Name, [a]))
-> [(Name, [a])] -> [(Name, [a])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Name, [a]) -> Maybe (Name, [a])
upd ([(Name, [a])] -> [(Name, [a])])
-> (Map Name [a] -> [(Name, [a])]) -> Map Name [a] -> [(Name, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name [a] -> [(Name, [a])]
forall k a. Map k a -> [(k, a)]
Map.toAscList
          where
          upd :: (C.Name, [a]) -> Maybe (C.Name, [a])
          upd :: (Name, [a]) -> Maybe (Name, [a])
upd (Name
x, [a]
ys) = Name -> Maybe Name
f Name
x Maybe Name -> (Name -> (Name, [a])) -> Maybe (Name, [a])
forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&> \ Name
x' -> (Name
x', Range -> [a] -> [a]
forall a. SetBindingSite a => Range -> a -> a
setBindingSite (Name -> Range
forall a. HasRange a => a -> Range
getRange Name
x') [a]
ys)

-- | Rename the abstract names in a scope.
renameCanonicalNames :: Map A.QName A.QName -> Map A.ModuleName A.ModuleName ->
                        Scope -> Scope
renameCanonicalNames :: Map QName QName -> Map ModuleName ModuleName -> Scope -> Scope
renameCanonicalNames Map QName QName
renD Map ModuleName ModuleName
renM = (NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet)
-> Scope
-> Scope
mapScope_ NamesInScope -> NamesInScope
renameD ModulesInScope -> ModulesInScope
renameM ((QName -> QName) -> InScopeSet -> InScopeSet
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map QName -> QName
newName)
  where
    newName :: QName -> QName
newName QName
x = QName -> QName -> Map QName QName -> QName
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault QName
x QName
x Map QName QName
renD
    newMod :: ModuleName -> ModuleName
newMod  ModuleName
x = ModuleName -> ModuleName -> Map ModuleName ModuleName -> ModuleName
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault ModuleName
x ModuleName
x Map ModuleName ModuleName
renM

    renameD :: NamesInScope -> NamesInScope
renameD = ([AbstractName] -> [AbstractName]) -> NamesInScope -> NamesInScope
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (([AbstractName] -> [AbstractName])
 -> NamesInScope -> NamesInScope)
-> ([AbstractName] -> [AbstractName])
-> NamesInScope
-> NamesInScope
forall a b. (a -> b) -> a -> b
$ (AbstractName -> AbstractName) -> [AbstractName] -> [AbstractName]
forall a b. (a -> b) -> [a] -> [b]
map ((AbstractName -> AbstractName)
 -> [AbstractName] -> [AbstractName])
-> (AbstractName -> AbstractName)
-> [AbstractName]
-> [AbstractName]
forall a b. (a -> b) -> a -> b
$ Lens' QName AbstractName -> LensMap QName AbstractName
forall i o. Lens' i o -> LensMap i o
over (QName -> f QName) -> AbstractName -> f AbstractName
Lens' QName AbstractName
lensAnameName QName -> QName
newName
    renameM :: ModulesInScope -> ModulesInScope
renameM = ([AbstractModule] -> [AbstractModule])
-> ModulesInScope -> ModulesInScope
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (([AbstractModule] -> [AbstractModule])
 -> ModulesInScope -> ModulesInScope)
-> ([AbstractModule] -> [AbstractModule])
-> ModulesInScope
-> ModulesInScope
forall a b. (a -> b) -> a -> b
$ (AbstractModule -> AbstractModule)
-> [AbstractModule] -> [AbstractModule]
forall a b. (a -> b) -> [a] -> [b]
map ((AbstractModule -> AbstractModule)
 -> [AbstractModule] -> [AbstractModule])
-> (AbstractModule -> AbstractModule)
-> [AbstractModule]
-> [AbstractModule]
forall a b. (a -> b) -> a -> b
$ Lens' ModuleName AbstractModule
-> LensMap ModuleName AbstractModule
forall i o. Lens' i o -> LensMap i o
over (ModuleName -> f ModuleName) -> AbstractModule -> f AbstractModule
Lens' ModuleName AbstractModule
lensAmodName  ModuleName -> ModuleName
newMod

-- | Remove private name space of a scope.
--
--   Should be a right identity for 'exportedNamesInScope'.
--   @exportedNamesInScope . restrictPrivate == exportedNamesInScope@.
restrictPrivate :: Scope -> Scope
restrictPrivate :: Scope -> Scope
restrictPrivate Scope
s = NameSpaceId -> NameSpace -> Scope -> Scope
setNameSpace NameSpaceId
PrivateNS NameSpace
emptyNameSpace
                  (Scope -> Scope) -> Scope -> Scope
forall a b. (a -> b) -> a -> b
$ Scope
s { scopeImports :: Map QName ModuleName
scopeImports = Map QName ModuleName
forall k a. Map k a
Map.empty }

-- | Remove private things from the given module from a scope.
restrictLocalPrivate :: ModuleName -> Scope -> Scope
restrictLocalPrivate :: ModuleName -> Scope -> Scope
restrictLocalPrivate ModuleName
m =
  NameSpaceId
-> (NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet)
-> Scope
-> Scope
mapScopeNS NameSpaceId
PrivateNS
    (([AbstractName] -> Maybe [AbstractName])
-> NamesInScope -> NamesInScope
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe [AbstractName] -> Maybe [AbstractName]
rName)
    (([AbstractModule] -> Maybe [AbstractModule])
-> ModulesInScope -> ModulesInScope
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe [AbstractModule] -> Maybe [AbstractModule]
rMod)
    ((QName -> Bool) -> InScopeSet -> InScopeSet
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not (Bool -> Bool) -> (QName -> Bool) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> ModuleName -> Bool
`isInModule` ModuleName
m)))
  where
    rName :: [AbstractName] -> Maybe [AbstractName]
rName [AbstractName]
as = ([AbstractName] -> Bool) -> [AbstractName] -> Maybe [AbstractName]
forall a. (a -> Bool) -> a -> Maybe a
filterMaybe (Bool -> Bool
not (Bool -> Bool)
-> ([AbstractName] -> Bool) -> [AbstractName] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AbstractName] -> Bool
forall a. Null a => a -> Bool
null) ([AbstractName] -> Maybe [AbstractName])
-> [AbstractName] -> Maybe [AbstractName]
forall a b. (a -> b) -> a -> b
$ (AbstractName -> Bool) -> [AbstractName] -> [AbstractName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (AbstractName -> Bool) -> AbstractName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> ModuleName -> Bool
`isInModule`        ModuleName
m) (QName -> Bool) -> (AbstractName -> QName) -> AbstractName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractName -> QName
anameName) [AbstractName]
as
    rMod :: [AbstractModule] -> Maybe [AbstractModule]
rMod  [AbstractModule]
as = ([AbstractModule] -> Bool)
-> [AbstractModule] -> Maybe [AbstractModule]
forall a. (a -> Bool) -> a -> Maybe a
filterMaybe (Bool -> Bool
not (Bool -> Bool)
-> ([AbstractModule] -> Bool) -> [AbstractModule] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AbstractModule] -> Bool
forall a. Null a => a -> Bool
null) ([AbstractModule] -> Maybe [AbstractModule])
-> [AbstractModule] -> Maybe [AbstractModule]
forall a b. (a -> b) -> a -> b
$ (AbstractModule -> Bool) -> [AbstractModule] -> [AbstractModule]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (AbstractModule -> Bool) -> AbstractModule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName -> ModuleName -> Bool
`isLtChildModuleOf` ModuleName
m) (ModuleName -> Bool)
-> (AbstractModule -> ModuleName) -> AbstractModule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractModule -> ModuleName
amodName)  [AbstractModule]
as

-- | Filter privates out of a `ScopeInfo`
withoutPrivates :: ScopeInfo -> ScopeInfo
withoutPrivates :: ScopeInfo -> ScopeInfo
withoutPrivates ScopeInfo
scope = Lens' (Map ModuleName Scope) ScopeInfo
-> LensMap (Map ModuleName Scope) ScopeInfo
forall i o. Lens' i o -> LensMap i o
over (Map ModuleName Scope -> f (Map ModuleName Scope))
-> ScopeInfo -> f ScopeInfo
Lens' (Map ModuleName Scope) ScopeInfo
scopeModules ((Scope -> Scope) -> Map ModuleName Scope -> Map ModuleName Scope
forall a b. (a -> b) -> Map ModuleName a -> Map ModuleName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Scope -> Scope) -> Map ModuleName Scope -> Map ModuleName Scope)
-> (Scope -> Scope) -> Map ModuleName Scope -> Map ModuleName Scope
forall a b. (a -> b) -> a -> b
$ ModuleName -> Scope -> Scope
restrictLocalPrivate ModuleName
m) ScopeInfo
scope
  where
  m :: ModuleName
m = ScopeInfo
scope ScopeInfo -> Lens' ModuleName ScopeInfo -> ModuleName
forall o i. o -> Lens' i o -> i
^. (ModuleName -> f ModuleName) -> ScopeInfo -> f ScopeInfo
Lens' ModuleName ScopeInfo
scopeCurrent

-- | Disallow using generalized variables from the scope
disallowGeneralizedVars :: Scope -> Scope
disallowGeneralizedVars :: Scope -> Scope
disallowGeneralizedVars = (NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet)
-> Scope
-> Scope
mapScope_ ((([AbstractName] -> [AbstractName]) -> NamesInScope -> NamesInScope
forall a b. (a -> b) -> Map Name a -> Map Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([AbstractName] -> [AbstractName])
 -> NamesInScope -> NamesInScope)
-> ((AbstractName -> AbstractName)
    -> [AbstractName] -> [AbstractName])
-> (AbstractName -> AbstractName)
-> NamesInScope
-> NamesInScope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbstractName -> AbstractName) -> [AbstractName] -> [AbstractName]
forall a b. (a -> b) -> [a] -> [b]
map) AbstractName -> AbstractName
disallow) ModulesInScope -> ModulesInScope
forall a. a -> a
id InScopeSet -> InScopeSet
forall a. a -> a
id
  where
    disallow :: AbstractName -> AbstractName
disallow AbstractName
a = AbstractName
a { anameKind :: KindOfName
anameKind = KindOfName -> KindOfName
disallowGen (AbstractName -> KindOfName
anameKind AbstractName
a) }
    disallowGen :: KindOfName -> KindOfName
disallowGen KindOfName
GeneralizeName = KindOfName
DisallowedGeneralizeName
    disallowGen KindOfName
k              = KindOfName
k

-- | Add an explanation to why things are in scope.
inScopeBecause :: (WhyInScope -> WhyInScope) -> Scope -> Scope
inScopeBecause :: (WhyInScope -> WhyInScope) -> Scope -> Scope
inScopeBecause WhyInScope -> WhyInScope
f = (NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet)
-> Scope
-> Scope
mapScope_ NamesInScope -> NamesInScope
mapName ModulesInScope -> ModulesInScope
mapMod InScopeSet -> InScopeSet
forall a. a -> a
id
  where
    mapName :: NamesInScope -> NamesInScope
mapName = ([AbstractName] -> [AbstractName]) -> NamesInScope -> NamesInScope
forall a b. (a -> b) -> Map Name a -> Map Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([AbstractName] -> [AbstractName])
 -> NamesInScope -> NamesInScope)
-> ((AbstractName -> AbstractName)
    -> [AbstractName] -> [AbstractName])
-> (AbstractName -> AbstractName)
-> NamesInScope
-> NamesInScope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbstractName -> AbstractName) -> [AbstractName] -> [AbstractName]
forall a b. (a -> b) -> [a] -> [b]
map ((AbstractName -> AbstractName) -> NamesInScope -> NamesInScope)
-> (AbstractName -> AbstractName) -> NamesInScope -> NamesInScope
forall a b. (a -> b) -> a -> b
$ \AbstractName
a -> AbstractName
a { anameLineage :: WhyInScope
anameLineage = WhyInScope -> WhyInScope
f (WhyInScope -> WhyInScope) -> WhyInScope -> WhyInScope
forall a b. (a -> b) -> a -> b
$ AbstractName -> WhyInScope
anameLineage AbstractName
a }
    mapMod :: ModulesInScope -> ModulesInScope
mapMod  = ([AbstractModule] -> [AbstractModule])
-> ModulesInScope -> ModulesInScope
forall a b. (a -> b) -> Map Name a -> Map Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([AbstractModule] -> [AbstractModule])
 -> ModulesInScope -> ModulesInScope)
-> ((AbstractModule -> AbstractModule)
    -> [AbstractModule] -> [AbstractModule])
-> (AbstractModule -> AbstractModule)
-> ModulesInScope
-> ModulesInScope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbstractModule -> AbstractModule)
-> [AbstractModule] -> [AbstractModule]
forall a b. (a -> b) -> [a] -> [b]
map ((AbstractModule -> AbstractModule)
 -> ModulesInScope -> ModulesInScope)
-> (AbstractModule -> AbstractModule)
-> ModulesInScope
-> ModulesInScope
forall a b. (a -> b) -> a -> b
$ \AbstractModule
a -> AbstractModule
a { amodLineage :: WhyInScope
amodLineage  = WhyInScope -> WhyInScope
f (WhyInScope -> WhyInScope) -> WhyInScope -> WhyInScope
forall a b. (a -> b) -> a -> b
$ AbstractModule -> WhyInScope
amodLineage AbstractModule
a  }

-- | Get the public parts of the public modules of a scope
publicModules :: ScopeInfo -> Map A.ModuleName Scope
publicModules :: ScopeInfo -> Map ModuleName Scope
publicModules ScopeInfo
scope = (ModuleName -> Scope -> Bool)
-> Map ModuleName Scope -> Map ModuleName Scope
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\ ModuleName
m Scope
_ -> ModuleName -> Bool
reachable ModuleName
m) Map ModuleName Scope
allMods
  where
    -- Get all modules in the ScopeInfo.
    allMods :: Map ModuleName Scope
allMods   = (Scope -> Scope) -> Map ModuleName Scope -> Map ModuleName Scope
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Scope -> Scope
restrictPrivate (Map ModuleName Scope -> Map ModuleName Scope)
-> Map ModuleName Scope -> Map ModuleName Scope
forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope ScopeInfo
-> Lens' (Map ModuleName Scope) ScopeInfo -> Map ModuleName Scope
forall o i. o -> Lens' i o -> i
^. (Map ModuleName Scope -> f (Map ModuleName Scope))
-> ScopeInfo -> f ScopeInfo
Lens' (Map ModuleName Scope) ScopeInfo
scopeModules
    root :: ModuleName
root      = ScopeInfo
scope ScopeInfo -> Lens' ModuleName ScopeInfo -> ModuleName
forall o i. o -> Lens' i o -> i
^. (ModuleName -> f ModuleName) -> ScopeInfo -> f ScopeInfo
Lens' ModuleName ScopeInfo
scopeCurrent

    modules :: Scope -> [ModuleName]
modules Scope
s = (AbstractModule -> ModuleName) -> [AbstractModule] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map AbstractModule -> ModuleName
amodName ([AbstractModule] -> [ModuleName])
-> [AbstractModule] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ [[AbstractModule]] -> [AbstractModule]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[AbstractModule]] -> [AbstractModule])
-> [[AbstractModule]] -> [AbstractModule]
forall a b. (a -> b) -> a -> b
$ ModulesInScope -> [[AbstractModule]]
forall k a. Map k a -> [a]
Map.elems (ModulesInScope -> [[AbstractModule]])
-> ModulesInScope -> [[AbstractModule]]
forall a b. (a -> b) -> a -> b
$ Scope -> ModulesInScope
forall a. InScope a => Scope -> ThingsInScope a
allNamesInScope Scope
s

    chase :: ModuleName -> [ModuleName]
chase ModuleName
m = ModuleName
m ModuleName -> [ModuleName] -> [ModuleName]
forall a. a -> [a] -> [a]
: (ModuleName -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModuleName -> [ModuleName]
chase [ModuleName]
ms
      where ms :: [ModuleName]
ms = [ModuleName]
-> (Scope -> [ModuleName]) -> Maybe Scope -> [ModuleName]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ModuleName]
forall a. HasCallStack => a
__IMPOSSIBLE__ Scope -> [ModuleName]
modules (Maybe Scope -> [ModuleName]) -> Maybe Scope -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ ModuleName -> Map ModuleName Scope -> Maybe Scope
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
m Map ModuleName Scope
allMods

    reachable :: ModuleName -> Bool
reachable = (ModuleName -> [ModuleName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ModuleName -> [ModuleName]
chase ModuleName
root)

publicNames :: ScopeInfo -> Set AbstractName
publicNames :: ScopeInfo -> Set AbstractName
publicNames ScopeInfo
scope =
  [AbstractName] -> Set AbstractName
forall a. Ord a => [a] -> Set a
Set.fromList ([AbstractName] -> Set AbstractName)
-> [AbstractName] -> Set AbstractName
forall a b. (a -> b) -> a -> b
$ [[AbstractName]] -> [AbstractName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[AbstractName]] -> [AbstractName])
-> [[AbstractName]] -> [AbstractName]
forall a b. (a -> b) -> a -> b
$ NamesInScope -> [[AbstractName]]
forall k a. Map k a -> [a]
Map.elems (NamesInScope -> [[AbstractName]])
-> NamesInScope -> [[AbstractName]]
forall a b. (a -> b) -> a -> b
$
  Scope -> NamesInScope
forall a. InScope a => Scope -> ThingsInScope a
exportedNamesInScope (Scope -> NamesInScope) -> Scope -> NamesInScope
forall a b. (a -> b) -> a -> b
$ [Scope] -> Scope
mergeScopes ([Scope] -> Scope) -> [Scope] -> Scope
forall a b. (a -> b) -> a -> b
$ Map ModuleName Scope -> [Scope]
forall k a. Map k a -> [a]
Map.elems (Map ModuleName Scope -> [Scope])
-> Map ModuleName Scope -> [Scope]
forall a b. (a -> b) -> a -> b
$ ScopeInfo -> Map ModuleName Scope
publicModules ScopeInfo
scope

everythingInScope :: ScopeInfo -> NameSpace
everythingInScope :: ScopeInfo -> NameSpace
everythingInScope ScopeInfo
scope = Scope -> NameSpace
allThingsInScope (Scope -> NameSpace) -> Scope -> NameSpace
forall a b. (a -> b) -> a -> b
$ [Scope] -> Scope
mergeScopes ([Scope] -> Scope) -> [Scope] -> Scope
forall a b. (a -> b) -> a -> b
$
    (Scope
s0 Scope -> [Scope] -> [Scope]
forall a. a -> [a] -> [a]
:) ([Scope] -> [Scope]) -> [Scope] -> [Scope]
forall a b. (a -> b) -> a -> b
$ (ModuleName -> Scope) -> [ModuleName] -> [Scope]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> Scope
look ([ModuleName] -> [Scope]) -> [ModuleName] -> [Scope]
forall a b. (a -> b) -> a -> b
$ Scope -> [ModuleName]
scopeParents Scope
s0
  where
    look :: ModuleName -> Scope
look ModuleName
m = Scope -> Maybe Scope -> Scope
forall a. a -> Maybe a -> a
fromMaybe Scope
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Scope -> Scope) -> Maybe Scope -> Scope
forall a b. (a -> b) -> a -> b
$ ModuleName -> Map ModuleName Scope -> Maybe Scope
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
m (Map ModuleName Scope -> Maybe Scope)
-> Map ModuleName Scope -> Maybe Scope
forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope ScopeInfo
-> Lens' (Map ModuleName Scope) ScopeInfo -> Map ModuleName Scope
forall o i. o -> Lens' i o -> i
^. (Map ModuleName Scope -> f (Map ModuleName Scope))
-> ScopeInfo -> f ScopeInfo
Lens' (Map ModuleName Scope) ScopeInfo
scopeModules
    s0 :: Scope
s0     = ModuleName -> Scope
look (ModuleName -> Scope) -> ModuleName -> Scope
forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope ScopeInfo -> Lens' ModuleName ScopeInfo -> ModuleName
forall o i. o -> Lens' i o -> i
^. (ModuleName -> f ModuleName) -> ScopeInfo -> f ScopeInfo
Lens' ModuleName ScopeInfo
scopeCurrent

everythingInScopeQualified :: ScopeInfo -> NameSpace
everythingInScopeQualified :: ScopeInfo -> NameSpace
everythingInScopeQualified ScopeInfo
scope =
  Scope -> NameSpace
allThingsInScope (Scope -> NameSpace) -> Scope -> NameSpace
forall a b. (a -> b) -> a -> b
$ [Scope] -> Scope
mergeScopes ([Scope] -> Scope) -> [Scope] -> Scope
forall a b. (a -> b) -> a -> b
$
    Set ModuleName -> [Scope] -> [Scope]
chase Set ModuleName
forall a. Set a
Set.empty [Scope]
scopes
  where
    s0 :: Scope
s0      = ModuleName -> Scope
look (ModuleName -> Scope) -> ModuleName -> Scope
forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope ScopeInfo -> Lens' ModuleName ScopeInfo -> ModuleName
forall o i. o -> Lens' i o -> i
^. (ModuleName -> f ModuleName) -> ScopeInfo -> f ScopeInfo
Lens' ModuleName ScopeInfo
scopeCurrent
    scopes :: [Scope]
scopes  = Scope
s0 Scope -> [Scope] -> [Scope]
forall a. a -> [a] -> [a]
: (ModuleName -> Scope) -> [ModuleName] -> [Scope]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> Scope
look (Scope -> [ModuleName]
scopeParents Scope
s0)
    look :: ModuleName -> Scope
look ModuleName
m  = Scope -> Maybe Scope -> Scope
forall a. a -> Maybe a -> a
fromMaybe Scope
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Scope -> Scope) -> Maybe Scope -> Scope
forall a b. (a -> b) -> a -> b
$ ModuleName -> Map ModuleName Scope -> Maybe Scope
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
m (Map ModuleName Scope -> Maybe Scope)
-> Map ModuleName Scope -> Maybe Scope
forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope ScopeInfo
-> Lens' (Map ModuleName Scope) ScopeInfo -> Map ModuleName Scope
forall o i. o -> Lens' i o -> i
^. (Map ModuleName Scope -> f (Map ModuleName Scope))
-> ScopeInfo -> f ScopeInfo
Lens' (Map ModuleName Scope) ScopeInfo
scopeModules
    lookP :: ModuleName -> Scope
lookP   = Scope -> Scope
restrictPrivate (Scope -> Scope) -> (ModuleName -> Scope) -> ModuleName -> Scope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Scope
look

    -- We start with the current module and all its parents and look through
    -- all their imports and submodules.
    chase :: Set ModuleName -> [Scope] -> [Scope]
chase Set ModuleName
seen [] = []
    chase Set ModuleName
seen (Scope
s : [Scope]
ss)
      | ModuleName -> Set ModuleName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ModuleName
name Set ModuleName
seen = Set ModuleName -> [Scope] -> [Scope]
chase Set ModuleName
seen [Scope]
ss
      | Bool
otherwise = Scope
s Scope -> [Scope] -> [Scope]
forall a. a -> [a] -> [a]
: Set ModuleName -> [Scope] -> [Scope]
chase (ModuleName -> Set ModuleName -> Set ModuleName
forall a. Ord a => a -> Set a -> Set a
Set.insert ModuleName
name Set ModuleName
seen) ([Scope]
imports [Scope] -> [Scope] -> [Scope]
forall a. [a] -> [a] -> [a]
++ [Scope]
submods [Scope] -> [Scope] -> [Scope]
forall a. [a] -> [a] -> [a]
++ [Scope]
ss)
      where
        -- #4166: only include things that are actually in scope here
        inscope :: a -> p -> Bool
inscope a
x p
_ = a -> NameInScope
forall a. LensInScope a => a -> NameInScope
isInScope a
x NameInScope -> NameInScope -> Bool
forall a. Eq a => a -> a -> Bool
== NameInScope
InScope
        name :: ModuleName
name    = Scope -> ModuleName
scopeName Scope
s
        imports :: [Scope]
imports = (ModuleName -> Scope) -> [ModuleName] -> [Scope]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> Scope
lookP ([ModuleName] -> [Scope]) -> [ModuleName] -> [Scope]
forall a b. (a -> b) -> a -> b
$ Map QName ModuleName -> [ModuleName]
forall k a. Map k a -> [a]
Map.elems (Map QName ModuleName -> [ModuleName])
-> Map QName ModuleName -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ Scope -> Map QName ModuleName
scopeImports Scope
s
        submods :: [Scope]
submods = (AbstractModule -> Scope) -> [AbstractModule] -> [Scope]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName -> Scope
lookP (ModuleName -> Scope)
-> (AbstractModule -> ModuleName) -> AbstractModule -> Scope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractModule -> ModuleName
amodName) ([AbstractModule] -> [Scope]) -> [AbstractModule] -> [Scope]
forall a b. (a -> b) -> a -> b
$ [[AbstractModule]] -> [AbstractModule]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[AbstractModule]] -> [AbstractModule])
-> [[AbstractModule]] -> [AbstractModule]
forall a b. (a -> b) -> a -> b
$ ModulesInScope -> [[AbstractModule]]
forall k a. Map k a -> [a]
Map.elems (ModulesInScope -> [[AbstractModule]])
-> ModulesInScope -> [[AbstractModule]]
forall a b. (a -> b) -> a -> b
$ (Name -> [AbstractModule] -> Bool)
-> ModulesInScope -> ModulesInScope
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey Name -> [AbstractModule] -> Bool
forall {a} {p}. LensInScope a => a -> p -> Bool
inscope (ModulesInScope -> ModulesInScope)
-> ModulesInScope -> ModulesInScope
forall a b. (a -> b) -> a -> b
$ Scope -> ModulesInScope
forall a. InScope a => Scope -> ThingsInScope a
allNamesInScope Scope
s

-- | Get all concrete names in scope. Includes bound variables.
concreteNamesInScope :: ScopeInfo -> Set C.QName
concreteNamesInScope :: ScopeInfo -> Set QName
concreteNamesInScope ScopeInfo
scope =
  [Set QName] -> Set QName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [ (forall a. InScope a => Scope -> ThingsInScope a)
-> Scope -> Set QName
build Scope -> ThingsInScope a
forall a. InScope a => Scope -> ThingsInScope a
allNamesInScope Scope
root, Set QName
imported, Set QName
locals ]
  where
    current :: Scope
current = ModuleName -> Scope
moduleScope (ModuleName -> Scope) -> ModuleName -> Scope
forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope ScopeInfo -> Lens' ModuleName ScopeInfo -> ModuleName
forall o i. o -> Lens' i o -> i
^. (ModuleName -> f ModuleName) -> ScopeInfo -> f ScopeInfo
Lens' ModuleName ScopeInfo
scopeCurrent
    root :: Scope
root    = [Scope] -> Scope
mergeScopes ([Scope] -> Scope) -> [Scope] -> Scope
forall a b. (a -> b) -> a -> b
$ Scope
current Scope -> [Scope] -> [Scope]
forall a. a -> [a] -> [a]
: (ModuleName -> Scope) -> [ModuleName] -> [Scope]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> Scope
moduleScope (Scope -> [ModuleName]
scopeParents Scope
current)

    locals :: Set QName
locals  = [QName] -> Set QName
forall a. Ord a => [a] -> Set a
Set.fromList [ Name -> QName
C.QName Name
x | (Name
x, LocalVar
_) <- ScopeInfo
scope ScopeInfo -> Lens' LocalVars ScopeInfo -> LocalVars
forall o i. o -> Lens' i o -> i
^. (LocalVars -> f LocalVars) -> ScopeInfo -> f ScopeInfo
Lens' LocalVars ScopeInfo
scopeLocals ]

    imported :: Set QName
imported = [Set QName] -> Set QName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
               [ QName -> Set QName -> Set QName
qual QName
c ((forall a. InScope a => Scope -> ThingsInScope a)
-> Scope -> Set QName
build Scope -> ThingsInScope a
forall a. InScope a => Scope -> ThingsInScope a
exportedNamesInScope (Scope -> Set QName) -> Scope -> Set QName
forall a b. (a -> b) -> a -> b
$ ModuleName -> Scope
moduleScope ModuleName
a)
               | (QName
c, ModuleName
a) <- Map QName ModuleName -> [(QName, ModuleName)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map QName ModuleName -> [(QName, ModuleName)])
-> Map QName ModuleName -> [(QName, ModuleName)]
forall a b. (a -> b) -> a -> b
$ Scope -> Map QName ModuleName
scopeImports Scope
root ]
    qual :: QName -> Set QName -> Set QName
qual QName
c = (QName -> QName) -> Set QName -> Set QName
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (QName -> QName -> QName
q QName
c)
      where
        q :: QName -> QName -> QName
q (C.QName Name
x)  = Name -> QName -> QName
C.Qual Name
x
        q (C.Qual Name
m QName
x) = Name -> QName -> QName
C.Qual Name
m (QName -> QName) -> (QName -> QName) -> QName -> QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> QName -> QName
q QName
x

    build :: (forall a. InScope a => Scope -> ThingsInScope a) -> Scope -> Set C.QName
    build :: (forall a. InScope a => Scope -> ThingsInScope a)
-> Scope -> Set QName
build forall a. InScope a => Scope -> ThingsInScope a
getNames Scope
s = [Set QName] -> Set QName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set QName] -> Set QName) -> [Set QName] -> Set QName
forall a b. (a -> b) -> a -> b
$
        [QName] -> Set QName
forall a. Eq a => [a] -> Set a
Set.fromAscList
          ((Name -> QName) -> [Name] -> [QName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> QName
C.QName ([Name] -> [QName]) -> [Name] -> [QName]
forall a b. (a -> b) -> a -> b
$
           NamesInScope -> [Name]
forall k a. Map k a -> [k]
Map.keys (Scope -> NamesInScope
forall a. InScope a => Scope -> ThingsInScope a
getNames Scope
s :: ThingsInScope AbstractName)) Set QName -> [Set QName] -> [Set QName]
forall a. a -> [a] -> [a]
:
          [ (QName -> QName) -> Set QName -> Set QName
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (\ QName
y -> Name -> QName -> QName
C.Qual Name
x QName
y) (Set QName -> Set QName) -> Set QName -> Set QName
forall a b. (a -> b) -> a -> b
$
              (forall a. InScope a => Scope -> ThingsInScope a)
-> Scope -> Set QName
build Scope -> ThingsInScope a
forall a. InScope a => Scope -> ThingsInScope a
exportedNamesInScope (Scope -> Set QName) -> Scope -> Set QName
forall a b. (a -> b) -> a -> b
$ ModuleName -> Scope
moduleScope ModuleName
m
          | (Name
x, [AbstractModule]
mods) <- ModulesInScope -> [(Name, [AbstractModule])]
forall k a. Map k a -> [(k, a)]
Map.toList (Scope -> ModulesInScope
forall a. InScope a => Scope -> ThingsInScope a
getNames Scope
s)
          , Name -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Name
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"_"
          , AbsModule ModuleName
m WhyInScope
_ <- [AbstractModule]
mods ]

    moduleScope :: A.ModuleName -> Scope
    moduleScope :: ModuleName -> Scope
moduleScope ModuleName
m = Scope -> Maybe Scope -> Scope
forall a. a -> Maybe a -> a
fromMaybe Scope
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Scope -> Scope) -> Maybe Scope -> Scope
forall a b. (a -> b) -> a -> b
$ ModuleName -> Map ModuleName Scope -> Maybe Scope
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
m (Map ModuleName Scope -> Maybe Scope)
-> Map ModuleName Scope -> Maybe Scope
forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope ScopeInfo
-> Lens' (Map ModuleName Scope) ScopeInfo -> Map ModuleName Scope
forall o i. o -> Lens' i o -> i
^. (Map ModuleName Scope -> f (Map ModuleName Scope))
-> ScopeInfo -> f ScopeInfo
Lens' (Map ModuleName Scope) ScopeInfo
scopeModules

-- | Look up a name in the scope
scopeLookup :: InScope a => C.QName -> ScopeInfo -> [a]
scopeLookup :: forall a. InScope a => QName -> ScopeInfo -> [a]
scopeLookup QName
q ScopeInfo
scope = ((a, Access) -> a) -> [(a, Access)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Access) -> a
forall a b. (a, b) -> a
fst ([(a, Access)] -> [a]) -> [(a, Access)] -> [a]
forall a b. (a -> b) -> a -> b
$ QName -> ScopeInfo -> [(a, Access)]
forall a. InScope a => QName -> ScopeInfo -> [(a, Access)]
scopeLookup' QName
q ScopeInfo
scope

scopeLookup' :: forall a. InScope a => C.QName -> ScopeInfo -> [(a, Access)]
scopeLookup' :: forall a. InScope a => QName -> ScopeInfo -> [(a, Access)]
scopeLookup' QName
q ScopeInfo
scope =
  ((a, Access) -> a) -> [(a, Access)] -> [(a, Access)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOn (a, Access) -> a
forall a b. (a, b) -> a
fst ([(a, Access)] -> [(a, Access)]) -> [(a, Access)] -> [(a, Access)]
forall a b. (a -> b) -> a -> b
$
    QName -> Scope -> [(a, Access)]
forall a. InScope a => QName -> Scope -> [(a, Access)]
findName QName
q Scope
root [(a, Access)] -> [(a, Access)] -> [(a, Access)]
forall a. [a] -> [a] -> [a]
++ Maybe (a, Access) -> [(a, Access)]
forall a. Maybe a -> [a]
maybeToList Maybe (a, Access)
topImports [(a, Access)] -> [(a, Access)] -> [(a, Access)]
forall a. [a] -> [a] -> [a]
++ [(a, Access)]
imports
  where

    -- 1. Finding a name in the current scope and its parents.

    moduleScope :: A.ModuleName -> Scope
    moduleScope :: ModuleName -> Scope
moduleScope ModuleName
m = Scope -> Maybe Scope -> Scope
forall a. a -> Maybe a -> a
fromMaybe Scope
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Scope -> Scope) -> Maybe Scope -> Scope
forall a b. (a -> b) -> a -> b
$ ModuleName -> Map ModuleName Scope -> Maybe Scope
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
m (Map ModuleName Scope -> Maybe Scope)
-> Map ModuleName Scope -> Maybe Scope
forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope ScopeInfo
-> Lens' (Map ModuleName Scope) ScopeInfo -> Map ModuleName Scope
forall o i. o -> Lens' i o -> i
^. (Map ModuleName Scope -> f (Map ModuleName Scope))
-> ScopeInfo -> f ScopeInfo
Lens' (Map ModuleName Scope) ScopeInfo
scopeModules

    current :: Scope
    current :: Scope
current = ModuleName -> Scope
moduleScope (ModuleName -> Scope) -> ModuleName -> Scope
forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope ScopeInfo -> Lens' ModuleName ScopeInfo -> ModuleName
forall o i. o -> Lens' i o -> i
^. (ModuleName -> f ModuleName) -> ScopeInfo -> f ScopeInfo
Lens' ModuleName ScopeInfo
scopeCurrent

    root    :: Scope
    root :: Scope
root    = [Scope] -> Scope
mergeScopes ([Scope] -> Scope) -> [Scope] -> Scope
forall a b. (a -> b) -> a -> b
$ Scope
current Scope -> [Scope] -> [Scope]
forall a. a -> [a] -> [a]
: (ModuleName -> Scope) -> [ModuleName] -> [Scope]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> Scope
moduleScope (Scope -> [ModuleName]
scopeParents Scope
current)

    -- Find a concrete, possibly qualified name in scope @s@.
    findName :: forall a. InScope a => C.QName -> Scope -> [(a, Access)]
    findName :: forall a. InScope a => QName -> Scope -> [(a, Access)]
findName QName
q0 Scope
s = case QName
q0 of
      C.QName Name
x  -> Name -> Scope -> [(a, Access)]
forall a. InScope a => Name -> Scope -> [(a, Access)]
findNameInScope Name
x Scope
s
      C.Qual Name
x QName
q -> do
        let -- Get the modules named @x@ in scope @s@.
            mods :: [A.ModuleName]
            mods :: [ModuleName]
mods = AbstractModule -> ModuleName
amodName (AbstractModule -> ModuleName)
-> ((AbstractModule, Access) -> AbstractModule)
-> (AbstractModule, Access)
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbstractModule, Access) -> AbstractModule
forall a b. (a, b) -> a
fst ((AbstractModule, Access) -> ModuleName)
-> [(AbstractModule, Access)] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Scope -> [(AbstractModule, Access)]
forall a. InScope a => Name -> Scope -> [(a, Access)]
findNameInScope Name
x Scope
s
            -- Get the definitions named @x@ in scope @s@ and interpret them as modules.
            -- Andreas, 2013-05-01: Issue 836 debates this feature:
            -- Qualified constructors are qualified by their datatype rather than a module
            defs :: [A.ModuleName] -- NB:: Defined but not used
            defs :: [ModuleName]
defs = QName -> ModuleName
qnameToMName (QName -> ModuleName)
-> ((AbstractName, Access) -> QName)
-> (AbstractName, Access)
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractName -> QName
anameName (AbstractName -> QName)
-> ((AbstractName, Access) -> AbstractName)
-> (AbstractName, Access)
-> QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbstractName, Access) -> AbstractName
forall a b. (a, b) -> a
fst ((AbstractName, Access) -> ModuleName)
-> [(AbstractName, Access)] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Scope -> [(AbstractName, Access)]
forall a. InScope a => Name -> Scope -> [(a, Access)]
findNameInScope Name
x Scope
s
        -- Andreas, 2013-05-01:  Issue 836 complains about the feature
        -- that constructors can also be qualified by their datatype
        -- and projections by their record type.  This feature is off
        -- if we just consider the modules:
        ModuleName
m <- [ModuleName]
mods
        -- The feature is on if we consider also the data and record types:
        -- trace ("mods ++ defs = " ++ show (mods ++ defs)) $ do
        -- m <- nub $ mods ++ defs -- record types will appear both as a mod and a def
        -- Get the scope of module m, if any, and remove its private definitions.
        let ss :: Maybe Scope
ss  = ModuleName -> Map ModuleName Scope -> Maybe Scope
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
m (Map ModuleName Scope -> Maybe Scope)
-> Map ModuleName Scope -> Maybe Scope
forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope ScopeInfo
-> Lens' (Map ModuleName Scope) ScopeInfo -> Map ModuleName Scope
forall o i. o -> Lens' i o -> i
^. (Map ModuleName Scope -> f (Map ModuleName Scope))
-> ScopeInfo -> f ScopeInfo
Lens' (Map ModuleName Scope) ScopeInfo
scopeModules
            ss' :: Maybe Scope
ss' = Scope -> Scope
restrictPrivate (Scope -> Scope) -> Maybe Scope -> Maybe Scope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Scope
ss
        -- trace ("ss  = " ++ show ss ) $ do
        -- trace ("ss' = " ++ show ss') $ do
        Scope
s' <- Maybe Scope -> [Scope]
forall a. Maybe a -> [a]
maybeToList Maybe Scope
ss'
        QName -> Scope -> [(a, Access)]
forall a. InScope a => QName -> Scope -> [(a, Access)]
findName QName
q Scope
s'

    -- 2. Finding a name in the top imports.

    topImports :: Maybe (a, Access)
    topImports :: Maybe (a, Access)
topImports = case (InScopeTag a
forall a. InScope a => InScopeTag a
inScopeTag :: InScopeTag a) of
      InScopeTag a
NameTag   -> Maybe (a, Access)
forall a. Maybe a
Nothing
      InScopeTag a
ModuleTag -> (ModuleName -> AbstractModule)
-> (ModuleName, Access) -> (AbstractModule, Access)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (ModuleName -> WhyInScope -> AbstractModule
`AbsModule` WhyInScope
Defined) ((ModuleName, Access) -> (a, Access))
-> Maybe (ModuleName, Access) -> Maybe (a, Access)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Maybe (ModuleName, Access)
imported QName
q

    imported :: C.QName -> Maybe (A.ModuleName, Access)
    imported :: QName -> Maybe (ModuleName, Access)
imported QName
q = (ModuleName -> (ModuleName, Access))
-> Maybe ModuleName -> Maybe (ModuleName, Access)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Access
PublicAccess) (Maybe ModuleName -> Maybe (ModuleName, Access))
-> Maybe ModuleName -> Maybe (ModuleName, Access)
forall a b. (a -> b) -> a -> b
$ QName -> Map QName ModuleName -> Maybe ModuleName
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
q (Map QName ModuleName -> Maybe ModuleName)
-> Map QName ModuleName -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ Scope -> Map QName ModuleName
scopeImports Scope
root

    -- 3. Finding a name in the imports belonging to an initial part of the qualifier.

    imports :: [(a, Access)]
    imports :: [(a, Access)]
imports = do
      (QName
m, QName
x) <- QName -> [(QName, QName)]
splitName QName
q
      ModuleName
m <- Maybe ModuleName -> [ModuleName]
forall a. Maybe a -> [a]
maybeToList (Maybe ModuleName -> [ModuleName])
-> Maybe ModuleName -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ (ModuleName, Access) -> ModuleName
forall a b. (a, b) -> a
fst ((ModuleName, Access) -> ModuleName)
-> Maybe (ModuleName, Access) -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Maybe (ModuleName, Access)
imported QName
m
      QName -> Scope -> [(a, Access)]
forall a. InScope a => QName -> Scope -> [(a, Access)]
findName QName
x (Scope -> [(a, Access)]) -> Scope -> [(a, Access)]
forall a b. (a -> b) -> a -> b
$ Scope -> Scope
restrictPrivate (Scope -> Scope) -> Scope -> Scope
forall a b. (a -> b) -> a -> b
$ ModuleName -> Scope
moduleScope ModuleName
m

    -- return all possible splittings, e.g.
    -- splitName X.Y.Z = [(X, Y.Z), (X.Y, Z)]
    splitName :: C.QName -> [(C.QName, C.QName)]
    splitName :: QName -> [(QName, QName)]
splitName (C.QName Name
x)  = []
    splitName (C.Qual Name
x QName
q) =
      (Name -> QName
C.QName Name
x, QName
q) (QName, QName) -> [(QName, QName)] -> [(QName, QName)]
forall a. a -> [a] -> [a]
: [ (Name -> QName -> QName
C.Qual Name
x QName
m, QName
r) | (QName
m, QName
r) <- QName -> [(QName, QName)]
splitName QName
q ]


-- * Inverse look-up

data AllowAmbiguousNames
  = AmbiguousAnything
      -- ^ Used for instance arguments to check whether a name is in scope,
      --   but we do not care whether is is ambiguous
  | AmbiguousConProjs
      -- ^ Ambiguous constructors, projections, or pattern synonyms.
  | AmbiguousNothing
  deriving (AllowAmbiguousNames -> AllowAmbiguousNames -> Bool
(AllowAmbiguousNames -> AllowAmbiguousNames -> Bool)
-> (AllowAmbiguousNames -> AllowAmbiguousNames -> Bool)
-> Eq AllowAmbiguousNames
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AllowAmbiguousNames -> AllowAmbiguousNames -> Bool
== :: AllowAmbiguousNames -> AllowAmbiguousNames -> Bool
$c/= :: AllowAmbiguousNames -> AllowAmbiguousNames -> Bool
/= :: AllowAmbiguousNames -> AllowAmbiguousNames -> Bool
Eq)

isNameInScope :: A.QName -> ScopeInfo -> Bool
isNameInScope :: QName -> ScopeInfo -> Bool
isNameInScope QName
q ScopeInfo
scope =
  Account -> Bool -> Bool
forall a. Account -> a -> a
billToPure [ Phase
Scoping, Phase
InverseScopeLookup ] (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
  QName -> InScopeSet -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member QName
q (ScopeInfo
scope ScopeInfo -> Lens' InScopeSet ScopeInfo -> InScopeSet
forall o i. o -> Lens' i o -> i
^. (InScopeSet -> f InScopeSet) -> ScopeInfo -> f ScopeInfo
Lens' InScopeSet ScopeInfo
scopeInScope)

isNameInScopeUnqualified :: A.QName -> ScopeInfo -> Bool
isNameInScopeUnqualified :: QName -> ScopeInfo -> Bool
isNameInScopeUnqualified QName
q ScopeInfo
scope =
  case AllowAmbiguousNames -> QName -> ScopeInfo -> [QName]
inverseScopeLookupName' AllowAmbiguousNames
AmbiguousNothing QName
q ScopeInfo
scope of
    C.QName{} : [QName]
_ -> Bool
True -- NOTE: inverseScopeLookupName' puts unqualified names first
    [QName]
_             -> Bool
False

-- | Find the concrete names that map (uniquely) to a given abstract qualified name.
--   Sort by number of modules in the qualified name, unqualified names first.
inverseScopeLookupName :: A.QName -> ScopeInfo -> [C.QName]
inverseScopeLookupName :: QName -> ScopeInfo -> [QName]
inverseScopeLookupName = AllowAmbiguousNames -> QName -> ScopeInfo -> [QName]
inverseScopeLookupName' AllowAmbiguousNames
AmbiguousConProjs

inverseScopeLookupName' :: AllowAmbiguousNames -> A.QName -> ScopeInfo -> [C.QName]
inverseScopeLookupName' :: AllowAmbiguousNames -> QName -> ScopeInfo -> [QName]
inverseScopeLookupName' AllowAmbiguousNames
amb QName
q ScopeInfo
scope =
  [QName]
-> (NameMapEntry -> [QName]) -> Maybe NameMapEntry -> [QName]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (List1 QName -> [Item (List1 QName)]
List1 QName -> [QName]
forall l. IsList l => l -> [Item l]
List1.toList (List1 QName -> [QName])
-> (NameMapEntry -> List1 QName) -> NameMapEntry -> [QName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameMapEntry -> List1 QName
qnameConcrete) (Maybe NameMapEntry -> [QName]) -> Maybe NameMapEntry -> [QName]
forall a b. (a -> b) -> a -> b
$ AllowAmbiguousNames -> QName -> ScopeInfo -> Maybe NameMapEntry
inverseScopeLookupName'' AllowAmbiguousNames
amb QName
q ScopeInfo
scope

-- | A version of 'inverseScopeLookupName' that also delivers the 'KindOfName'.
--   Used in highlighting.
inverseScopeLookupName'' :: AllowAmbiguousNames -> A.QName -> ScopeInfo -> Maybe NameMapEntry
inverseScopeLookupName'' :: AllowAmbiguousNames -> QName -> ScopeInfo -> Maybe NameMapEntry
inverseScopeLookupName'' AllowAmbiguousNames
amb QName
q ScopeInfo
scope = Account -> Maybe NameMapEntry -> Maybe NameMapEntry
forall a. Account -> a -> a
billToPure [ Phase
Scoping , Phase
InverseScopeLookup ] (Maybe NameMapEntry -> Maybe NameMapEntry)
-> Maybe NameMapEntry -> Maybe NameMapEntry
forall a b. (a -> b) -> a -> b
$ do
  NameMapEntry KindOfName
k List1 QName
xs <- QName -> NameMap -> Maybe NameMapEntry
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
q (ScopeInfo
scope ScopeInfo -> Lens' NameMap ScopeInfo -> NameMap
forall o i. o -> Lens' i o -> i
^. (NameMap -> f NameMap) -> ScopeInfo -> f ScopeInfo
Lens' NameMap ScopeInfo
scopeInverseName)
  KindOfName -> List1 QName -> NameMapEntry
NameMapEntry KindOfName
k (List1 QName -> NameMapEntry)
-> Maybe (List1 QName) -> Maybe NameMapEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do [QName] -> Maybe (List1 QName)
forall a. [a] -> Maybe (NonEmpty a)
List1.nonEmpty ([QName] -> Maybe (List1 QName)) -> [QName] -> Maybe (List1 QName)
forall a b. (a -> b) -> a -> b
$ [QName] -> [QName]
best ([QName] -> [QName]) -> [QName] -> [QName]
forall a b. (a -> b) -> a -> b
$ (QName -> Bool) -> List1 QName -> [QName]
forall a. (a -> Bool) -> NonEmpty a -> [a]
List1.filter QName -> Bool
unambiguousName List1 QName
xs
  where
    best :: [C.QName] -> [C.QName]
    best :: [QName] -> [QName]
best = (QName -> Int) -> [QName] -> [QName]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn ((QName -> Int) -> [QName] -> [QName])
-> (QName -> Int) -> [QName] -> [QName]
forall a b. (a -> b) -> a -> b
$ NonEmpty Name -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (NonEmpty Name -> Int) -> (QName -> NonEmpty Name) -> QName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> NonEmpty Name
C.qnameParts

    unique :: forall a . [a] -> Bool
    unique :: forall a. [a] -> Bool
unique []      = Bool
forall a. HasCallStack => a
__IMPOSSIBLE__
    unique [a
_]     = Bool
True
    unique (a
_:a
_:[a]
_) = Bool
False

    unambiguousName :: C.QName -> Bool
    unambiguousName :: QName -> Bool
unambiguousName QName
q = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
      [ AllowAmbiguousNames
amb AllowAmbiguousNames -> AllowAmbiguousNames -> Bool
forall a. Eq a => a -> a -> Bool
== AllowAmbiguousNames
AmbiguousAnything
      , [AbstractName] -> Bool
forall a. [a] -> Bool
unique [AbstractName]
xs
      , AllowAmbiguousNames
amb AllowAmbiguousNames -> AllowAmbiguousNames -> Bool
forall a. Eq a => a -> a -> Bool
== AllowAmbiguousNames
AmbiguousConProjs Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
          [ (KindOfName -> Bool) -> [KindOfName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe Induction -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Induction -> Bool)
-> (KindOfName -> Maybe Induction) -> KindOfName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindOfName -> Maybe Induction
isConName) (KindOfName
kKindOfName -> [KindOfName] -> [KindOfName]
forall a. a -> [a] -> [a]
:[KindOfName]
ks)
          , KindOfName
k KindOfName -> [KindOfName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ KindOfName
FldName, KindOfName
PatternSynName ] Bool -> Bool -> Bool
&& (KindOfName -> Bool) -> [KindOfName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (KindOfName
k KindOfName -> KindOfName -> Bool
forall a. Eq a => a -> a -> Bool
==) [KindOfName]
ks
          ]
      ]
      where
      xs :: [AbstractName]
xs   = QName -> ScopeInfo -> [AbstractName]
forall a. InScope a => QName -> ScopeInfo -> [a]
scopeLookup QName
q ScopeInfo
scope
      KindOfName
k:[KindOfName]
ks = (AbstractName -> KindOfName) -> [AbstractName] -> [KindOfName]
forall a b. (a -> b) -> [a] -> [b]
map AbstractName -> KindOfName
anameKind [AbstractName]
xs

-- | Find the concrete names that map (uniquely) to a given abstract module name.
--   Sort by length, shortest first.
inverseScopeLookupModule :: A.ModuleName -> ScopeInfo -> [C.QName]
inverseScopeLookupModule :: ModuleName -> ScopeInfo -> [QName]
inverseScopeLookupModule = AllowAmbiguousNames -> ModuleName -> ScopeInfo -> [QName]
inverseScopeLookupModule' AllowAmbiguousNames
AmbiguousNothing

inverseScopeLookupModule' :: AllowAmbiguousNames -> A.ModuleName -> ScopeInfo -> [C.QName]
inverseScopeLookupModule' :: AllowAmbiguousNames -> ModuleName -> ScopeInfo -> [QName]
inverseScopeLookupModule' AllowAmbiguousNames
amb ModuleName
m ScopeInfo
scope = Account -> [QName] -> [QName]
forall a. Account -> a -> a
billToPure [ Phase
Scoping , Phase
InverseScopeLookup ] ([QName] -> [QName]) -> [QName] -> [QName]
forall a b. (a -> b) -> a -> b
$
  [QName] -> [QName]
best ([QName] -> [QName]) -> [QName] -> [QName]
forall a b. (a -> b) -> a -> b
$ (QName -> Bool) -> [QName] -> [QName]
forall a. (a -> Bool) -> [a] -> [a]
filter QName -> Bool
unambiguousModule ([QName] -> [QName]) -> [QName] -> [QName]
forall a b. (a -> b) -> a -> b
$ ModuleName -> [QName]
findModule ModuleName
m
  where
    findModule :: ModuleName -> [QName]
findModule ModuleName
m = [QName] -> Maybe [QName] -> [QName]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [QName] -> [QName]) -> Maybe [QName] -> [QName]
forall a b. (a -> b) -> a -> b
$ ModuleName -> ModuleMap -> Maybe [QName]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
m (ScopeInfo
scope ScopeInfo -> Lens' ModuleMap ScopeInfo -> ModuleMap
forall o i. o -> Lens' i o -> i
^. (ModuleMap -> f ModuleMap) -> ScopeInfo -> f ScopeInfo
Lens' ModuleMap ScopeInfo
scopeInverseModule)

    best :: [C.QName] -> [C.QName]
    best :: [QName] -> [QName]
best = (QName -> Int) -> [QName] -> [QName]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn ((QName -> Int) -> [QName] -> [QName])
-> (QName -> Int) -> [QName] -> [QName]
forall a b. (a -> b) -> a -> b
$ NonEmpty Name -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (NonEmpty Name -> Int) -> (QName -> NonEmpty Name) -> QName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> NonEmpty Name
C.qnameParts

    unique :: forall a . [a] -> Bool
    unique :: forall a. [a] -> Bool
unique []      = Bool
forall a. HasCallStack => a
__IMPOSSIBLE__
    unique [a
_]     = Bool
True
    unique (a
_:a
_:[a]
_) = Bool
False

    unambiguousModule :: QName -> Bool
unambiguousModule QName
q = AllowAmbiguousNames
amb AllowAmbiguousNames -> AllowAmbiguousNames -> Bool
forall a. Eq a => a -> a -> Bool
== AllowAmbiguousNames
AmbiguousAnything Bool -> Bool -> Bool
|| [AbstractModule] -> Bool
forall a. [a] -> Bool
unique (QName -> ScopeInfo -> [AbstractModule]
forall a. InScope a => QName -> ScopeInfo -> [a]
scopeLookup QName
q ScopeInfo
scope :: [AbstractModule])

recomputeInverseScopeMaps :: ScopeInfo -> ScopeInfo
recomputeInverseScopeMaps :: ScopeInfo -> ScopeInfo
recomputeInverseScopeMaps ScopeInfo
scope = Account -> ScopeInfo -> ScopeInfo
forall a. Account -> a -> a
billToPure [ Phase
Scoping , Phase
InverseScopeLookup ] (ScopeInfo -> ScopeInfo) -> ScopeInfo -> ScopeInfo
forall a b. (a -> b) -> a -> b
$
  ScopeInfo
scope { _scopeInverseName :: NameMap
_scopeInverseName   = NameMap
nameMap
        , _scopeInverseModule :: ModuleMap
_scopeInverseModule = [(ModuleName, [QName])] -> ModuleMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (ModuleName
x, ModuleName -> [QName]
findModule ModuleName
x) | ModuleName
x <- Map ModuleName [(ModuleName, Name)] -> [ModuleName]
forall k a. Map k a -> [k]
Map.keys Map ModuleName [(ModuleName, Name)]
moduleMap [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ ModuleMap -> [ModuleName]
forall k a. Map k a -> [k]
Map.keys ModuleMap
importMap ]
        , _scopeInScope :: InScopeSet
_scopeInScope       = NameSpace -> InScopeSet
nsInScope (NameSpace -> InScopeSet) -> NameSpace -> InScopeSet
forall a b. (a -> b) -> a -> b
$ ScopeInfo -> NameSpace
everythingInScopeQualified ScopeInfo
scope
        }
  where
    this :: ModuleName
this = ScopeInfo
scope ScopeInfo -> Lens' ModuleName ScopeInfo -> ModuleName
forall o i. o -> Lens' i o -> i
^. (ModuleName -> f ModuleName) -> ScopeInfo -> f ScopeInfo
Lens' ModuleName ScopeInfo
scopeCurrent
    current :: [ModuleName]
current = ModuleName
this ModuleName -> [ModuleName] -> [ModuleName]
forall a. a -> [a] -> [a]
: Scope -> [ModuleName]
scopeParents (ModuleName -> Scope
moduleScope ModuleName
this)
    scopes :: [(ModuleName, Scope)]
scopes  = [ (ModuleName
m, ModuleName -> Scope -> Scope
restrict ModuleName
m Scope
s) | (ModuleName
m, Scope
s) <- Map ModuleName Scope -> [(ModuleName, Scope)]
forall k a. Map k a -> [(k, a)]
Map.toList (ScopeInfo
scope ScopeInfo
-> Lens' (Map ModuleName Scope) ScopeInfo -> Map ModuleName Scope
forall o i. o -> Lens' i o -> i
^. (Map ModuleName Scope -> f (Map ModuleName Scope))
-> ScopeInfo -> f ScopeInfo
Lens' (Map ModuleName Scope) ScopeInfo
scopeModules) ]

    moduleScope :: A.ModuleName -> Scope
    moduleScope :: ModuleName -> Scope
moduleScope ModuleName
m = Scope -> Maybe Scope -> Scope
forall a. a -> Maybe a -> a
fromMaybe Scope
forall a. HasCallStack => a
__IMPOSSIBLE__ (Maybe Scope -> Scope) -> Maybe Scope -> Scope
forall a b. (a -> b) -> a -> b
$ ModuleName -> Map ModuleName Scope -> Maybe Scope
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
m (Map ModuleName Scope -> Maybe Scope)
-> Map ModuleName Scope -> Maybe Scope
forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope ScopeInfo
-> Lens' (Map ModuleName Scope) ScopeInfo -> Map ModuleName Scope
forall o i. o -> Lens' i o -> i
^. (Map ModuleName Scope -> f (Map ModuleName Scope))
-> ScopeInfo -> f ScopeInfo
Lens' (Map ModuleName Scope) ScopeInfo
scopeModules

    restrict :: ModuleName -> Scope -> Scope
restrict ModuleName
m Scope
s | ModuleName
m ModuleName -> [ModuleName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ModuleName]
current = Scope
s
                 | Bool
otherwise = Scope -> Scope
restrictPrivate Scope
s

    internalName :: C.QName -> Bool
    internalName :: QName -> Bool
internalName C.QName{} = Bool
False
    internalName (C.Qual Name
m QName
n) = Name -> Bool
intern Name
m Bool -> Bool -> Bool
|| QName -> Bool
internalName QName
n
      where
      -- Recognize fresh names created Parser.y
      intern :: Name -> Bool
intern (C.Name Range
_ NameInScope
_ (C.Id (Char
'.' : Char
'#' : FilePath
_) :| [])) = Bool
True
      intern Name
_ = Bool
False

    findName :: Ord a => Map a [(A.ModuleName, C.Name)] -> a -> [C.QName]
    findName :: forall a. Ord a => Map a [(ModuleName, Name)] -> a -> [QName]
findName Map a [(ModuleName, Name)]
table a
q = do
      (ModuleName
m, Name
x) <- [(ModuleName, Name)]
-> Maybe [(ModuleName, Name)] -> [(ModuleName, Name)]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [(ModuleName, Name)] -> [(ModuleName, Name)])
-> Maybe [(ModuleName, Name)] -> [(ModuleName, Name)]
forall a b. (a -> b) -> a -> b
$ a -> Map a [(ModuleName, Name)] -> Maybe [(ModuleName, Name)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
q Map a [(ModuleName, Name)]
table
      if ModuleName
m ModuleName -> [ModuleName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ModuleName]
current
        then QName -> [QName]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> QName
C.QName Name
x)
        else do
          QName
y <- ModuleName -> [QName]
findModule ModuleName
m
          let z :: QName
z = QName -> Name -> QName
C.qualify QName
y Name
x
          Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ QName -> Bool
internalName QName
z
          QName -> [QName]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return QName
z

    findModule :: A.ModuleName -> [C.QName]
    findModule :: ModuleName -> [QName]
findModule ModuleName
q = Map ModuleName [(ModuleName, Name)] -> ModuleName -> [QName]
forall a. Ord a => Map a [(ModuleName, Name)] -> a -> [QName]
findName Map ModuleName [(ModuleName, Name)]
moduleMap ModuleName
q [QName] -> [QName] -> [QName]
forall a. [a] -> [a] -> [a]
++
                   [QName] -> Maybe [QName] -> [QName]
forall a. a -> Maybe a -> a
fromMaybe [] (ModuleName -> ModuleMap -> Maybe [QName]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
q ModuleMap
importMap)

    importMap :: ModuleMap
importMap = ([QName] -> [QName] -> [QName])
-> [(ModuleName, [QName])] -> ModuleMap
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [QName] -> [QName] -> [QName]
forall a. [a] -> [a] -> [a]
(++) ([(ModuleName, [QName])] -> ModuleMap)
-> [(ModuleName, [QName])] -> ModuleMap
forall a b. (a -> b) -> a -> b
$ do
      (ModuleName
m, Scope
s) <- [(ModuleName, Scope)]
scopes
      (QName
x, ModuleName
y) <- Map QName ModuleName -> [(QName, ModuleName)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map QName ModuleName -> [(QName, ModuleName)])
-> Map QName ModuleName -> [(QName, ModuleName)]
forall a b. (a -> b) -> a -> b
$ Scope -> Map QName ModuleName
scopeImports Scope
s
      (ModuleName, [QName]) -> [(ModuleName, [QName])]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName
y, QName -> [QName]
forall el coll. Singleton el coll => el -> coll
singleton QName
x)

    moduleMap :: Map ModuleName [(ModuleName, Name)]
moduleMap = ([(ModuleName, Name)]
 -> [(ModuleName, Name)] -> [(ModuleName, Name)])
-> [(ModuleName, [(ModuleName, Name)])]
-> Map ModuleName [(ModuleName, Name)]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [(ModuleName, Name)]
-> [(ModuleName, Name)] -> [(ModuleName, Name)]
forall a. [a] -> [a] -> [a]
(++) ([(ModuleName, [(ModuleName, Name)])]
 -> Map ModuleName [(ModuleName, Name)])
-> [(ModuleName, [(ModuleName, Name)])]
-> Map ModuleName [(ModuleName, Name)]
forall a b. (a -> b) -> a -> b
$ do
      (ModuleName
m, Scope
s)  <- [(ModuleName, Scope)]
scopes
      (Name
x, [AbstractModule]
ms) <- ModulesInScope -> [(Name, [AbstractModule])]
forall k a. Map k a -> [(k, a)]
Map.toList (Scope -> ModulesInScope
forall a. InScope a => Scope -> ThingsInScope a
allNamesInScope Scope
s)
      ModuleName
q       <- AbstractModule -> ModuleName
amodName (AbstractModule -> ModuleName) -> [AbstractModule] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AbstractModule]
ms
      (ModuleName, [(ModuleName, Name)])
-> [(ModuleName, [(ModuleName, Name)])]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName
q, (ModuleName, Name) -> [(ModuleName, Name)]
forall el coll. Singleton el coll => el -> coll
singleton (ModuleName
m, Name
x))

    nameMap :: NameMap
    nameMap :: NameMap
nameMap = (NameMapEntry -> NameMapEntry -> NameMapEntry)
-> [(QName, NameMapEntry)] -> NameMap
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith NameMapEntry -> NameMapEntry -> NameMapEntry
forall a. Semigroup a => a -> a -> a
(<>) ([(QName, NameMapEntry)] -> NameMap)
-> [(QName, NameMapEntry)] -> NameMap
forall a b. (a -> b) -> a -> b
$ do
      (ModuleName
m, Scope
s)  <- [(ModuleName, Scope)]
scopes
      (Name
x, [AbstractName]
ms) <- NamesInScope -> [(Name, [AbstractName])]
forall k a. Map k a -> [(k, a)]
Map.toList (Scope -> NamesInScope
forall a. InScope a => Scope -> ThingsInScope a
allNamesInScope Scope
s)
      (QName
q, KindOfName
k)  <- (AbstractName -> QName
anameName (AbstractName -> QName)
-> (AbstractName -> KindOfName)
-> AbstractName
-> (QName, KindOfName)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& AbstractName -> KindOfName
anameKind) (AbstractName -> (QName, KindOfName))
-> [AbstractName] -> [(QName, KindOfName)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AbstractName]
ms
      let ret :: QName -> [(QName, NameMapEntry)]
ret QName
z = (QName, NameMapEntry) -> [(QName, NameMapEntry)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (QName
q, KindOfName -> List1 QName -> NameMapEntry
NameMapEntry KindOfName
k (List1 QName -> NameMapEntry) -> List1 QName -> NameMapEntry
forall a b. (a -> b) -> a -> b
$ QName -> List1 QName
forall el coll. Singleton el coll => el -> coll
singleton QName
z)
      if ModuleName
m ModuleName -> [ModuleName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ModuleName]
current
        then QName -> [(QName, NameMapEntry)]
ret (QName -> [(QName, NameMapEntry)])
-> QName -> [(QName, NameMapEntry)]
forall a b. (a -> b) -> a -> b
$ Name -> QName
C.QName Name
x
        else do
          QName
y <- ModuleName -> [QName]
findModule ModuleName
m
          let z :: QName
z = QName -> Name -> QName
C.qualify QName
y Name
x
          Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ QName -> Bool
internalName QName
z
          QName -> [(QName, NameMapEntry)]
ret QName
z

------------------------------------------------------------------------
-- * Update binding site
------------------------------------------------------------------------

-- | Set the 'nameBindingSite' in an abstract name.
class SetBindingSite a where
  setBindingSite :: Range -> a -> a

  default setBindingSite
    :: (SetBindingSite b, Functor t, t b ~ a)
    => Range -> a -> a
  setBindingSite = (b -> b) -> a -> a
(b -> b) -> t b -> t b
forall a b. (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> b) -> a -> a) -> (Range -> b -> b) -> Range -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> b -> b
forall a. SetBindingSite a => Range -> a -> a
setBindingSite

instance SetBindingSite a => SetBindingSite [a]

instance SetBindingSite A.Name where
  setBindingSite :: Range -> Name -> Name
setBindingSite Range
r Name
x = Name
x { nameBindingSite :: Range
nameBindingSite = Range
r }

instance SetBindingSite A.QName where
  setBindingSite :: Range -> QName -> QName
setBindingSite Range
r QName
x = QName
x { qnameName :: Name
qnameName = Range -> Name -> Name
forall a. SetBindingSite a => Range -> a -> a
setBindingSite Range
r (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ QName -> Name
qnameName QName
x }

-- | Sets the binding site of all names in the path.
instance SetBindingSite A.ModuleName where
  setBindingSite :: Range -> ModuleName -> ModuleName
setBindingSite Range
r (MName [Name]
x) = [Name] -> ModuleName
MName ([Name] -> ModuleName) -> [Name] -> ModuleName
forall a b. (a -> b) -> a -> b
$ Range -> [Name] -> [Name]
forall a. SetBindingSite a => Range -> a -> a
setBindingSite Range
r [Name]
x

instance SetBindingSite AbstractName where
  setBindingSite :: Range -> AbstractName -> AbstractName
setBindingSite Range
r AbstractName
x = AbstractName
x { anameName :: QName
anameName = Range -> QName -> QName
forall a. SetBindingSite a => Range -> a -> a
setBindingSite Range
r (QName -> QName) -> QName -> QName
forall a b. (a -> b) -> a -> b
$ AbstractName -> QName
anameName AbstractName
x }

instance SetBindingSite AbstractModule where
  setBindingSite :: Range -> AbstractModule -> AbstractModule
setBindingSite Range
r AbstractModule
x = AbstractModule
x { amodName :: ModuleName
amodName = Range -> ModuleName -> ModuleName
forall a. SetBindingSite a => Range -> a -> a
setBindingSite Range
r (ModuleName -> ModuleName) -> ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ AbstractModule -> ModuleName
amodName AbstractModule
x }


------------------------------------------------------------------------
-- * (Debug) printing
------------------------------------------------------------------------

instance Pretty AbstractName where
  pretty :: AbstractName -> Doc
pretty = QName -> Doc
forall a. Pretty a => a -> Doc
pretty (QName -> Doc) -> (AbstractName -> QName) -> AbstractName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractName -> QName
anameName

instance Pretty AbstractModule where
  pretty :: AbstractModule -> Doc
pretty = ModuleName -> Doc
forall a. Pretty a => a -> Doc
pretty (ModuleName -> Doc)
-> (AbstractModule -> ModuleName) -> AbstractModule -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractModule -> ModuleName
amodName

instance Pretty NameSpaceId where
  pretty :: NameSpaceId -> Doc
pretty = FilePath -> Doc
text (FilePath -> Doc)
-> (NameSpaceId -> FilePath) -> NameSpaceId -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    NameSpaceId
PublicNS        -> FilePath
"public"
    NameSpaceId
PrivateNS       -> FilePath
"private"
    NameSpaceId
ImportedNS      -> FilePath
"imported"

instance Pretty NameSpace where
  pretty :: NameSpace -> Doc
pretty = [Doc] -> Doc
forall (t :: * -> *). Foldable t => t Doc -> Doc
vcat ([Doc] -> Doc) -> (NameSpace -> [Doc]) -> NameSpace -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSpace -> [Doc]
prettyNameSpace

prettyNameSpace :: NameSpace -> [Doc]
prettyNameSpace :: NameSpace -> [Doc]
prettyNameSpace (NameSpace NamesInScope
names ModulesInScope
mods InScopeSet
_) =
    Doc -> [Doc] -> [Doc]
blockOfLines Doc
"names"   (((Name, [AbstractName]) -> Doc)
-> [(Name, [AbstractName])] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Name, [AbstractName]) -> Doc
forall a b. (Pretty a, Pretty b) => (a, b) -> Doc
pr ([(Name, [AbstractName])] -> [Doc])
-> [(Name, [AbstractName])] -> [Doc]
forall a b. (a -> b) -> a -> b
$ NamesInScope -> [(Name, [AbstractName])]
forall k a. Map k a -> [(k, a)]
Map.toList NamesInScope
names) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
    Doc -> [Doc] -> [Doc]
blockOfLines Doc
"modules" (((Name, [AbstractModule]) -> Doc)
-> [(Name, [AbstractModule])] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Name, [AbstractModule]) -> Doc
forall a b. (Pretty a, Pretty b) => (a, b) -> Doc
pr ([(Name, [AbstractModule])] -> [Doc])
-> [(Name, [AbstractModule])] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ModulesInScope -> [(Name, [AbstractModule])]
forall k a. Map k a -> [(k, a)]
Map.toList ModulesInScope
mods)
  where
    pr :: (Pretty a, Pretty b) => (a,b) -> Doc
    pr :: forall a b. (Pretty a, Pretty b) => (a, b) -> Doc
pr (a
x, b
y) = a -> Doc
forall a. Pretty a => a -> Doc
pretty a
x Doc -> Doc -> Doc
<+> Doc
"-->" Doc -> Doc -> Doc
<+> b -> Doc
forall a. Pretty a => a -> Doc
pretty b
y

instance Pretty Scope where
  pretty :: Scope -> Doc
pretty scope :: Scope
scope@Scope{ scopeName :: Scope -> ModuleName
scopeName = ModuleName
name, scopeParents :: Scope -> [ModuleName]
scopeParents = [ModuleName]
parents, scopeImports :: Scope -> Map QName ModuleName
scopeImports = Map QName ModuleName
imps } =
    [Doc] -> Doc
forall (t :: * -> *). Foldable t => t Doc -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [[Doc]] -> [Doc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [ Doc
"scope" Doc -> Doc -> Doc
<+> ModuleName -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName
name ]
      , Scope -> ScopeNameSpaces
scopeNameSpaces Scope
scope ScopeNameSpaces -> ((NameSpaceId, NameSpace) -> [Doc]) -> [Doc]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (NameSpaceId
nsid, NameSpace
ns) -> do
          Doc -> [Doc] -> [Doc]
block (NameSpaceId -> Doc
forall a. Pretty a => a -> Doc
pretty NameSpaceId
nsid) ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ NameSpace -> [Doc]
prettyNameSpace NameSpace
ns
      , [QName] -> [Doc] -> ([QName] -> [Doc]) -> [Doc]
forall a b. Null a => a -> b -> (a -> b) -> b
ifNull (Map QName ModuleName -> [QName]
forall k a. Map k a -> [k]
Map.keys Map QName ModuleName
imps) [] {-else-} (([QName] -> [Doc]) -> [Doc]) -> ([QName] -> [Doc]) -> [Doc]
forall a b. (a -> b) -> a -> b
$ \ [QName]
ks ->
          Doc -> [Doc] -> [Doc]
block Doc
"imports" [ [QName] -> Doc
forall a. Pretty a => [a] -> Doc
prettyList [QName]
ks ]
      ]
    where
    block :: Doc -> [Doc] -> [Doc]
    block :: Doc -> [Doc] -> [Doc]
block Doc
hd = (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2) ([Doc] -> [Doc]) -> ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
blockOfLines Doc
hd

-- | Add first string only if list is non-empty.
blockOfLines :: Doc -> [Doc] -> [Doc]
blockOfLines :: Doc -> [Doc] -> [Doc]
blockOfLines Doc
_  [] = []
blockOfLines Doc
hd [Doc]
ss = Doc
hd Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2) [Doc]
ss

instance Pretty ScopeInfo where
  pretty :: ScopeInfo -> Doc
pretty (ScopeInfo ModuleName
this Map ModuleName Scope
mods LocalVars
toBind LocalVars
locals PrecedenceStack
ctx NameMap
_ ModuleMap
_ InScopeSet
_ Fixities
_ Polarities
_) = [Doc] -> Doc
forall (t :: * -> *). Foldable t => t Doc -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [[Doc]] -> [Doc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [ Doc
"ScopeInfo"
      , Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"current =" Doc -> Doc -> Doc
<+> ModuleName -> Doc
forall a. Pretty a => a -> Doc
pretty ModuleName
this
      ]
    , [ Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"toBind  =" Doc -> Doc -> Doc
<+> LocalVars -> Doc
forall a. Pretty a => a -> Doc
pretty LocalVars
locals | Bool -> Bool
not (LocalVars -> Bool
forall a. Null a => a -> Bool
null LocalVars
toBind) ]
    , [ Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"locals  =" Doc -> Doc -> Doc
<+> LocalVars -> Doc
forall a. Pretty a => a -> Doc
pretty LocalVars
locals | Bool -> Bool
not (LocalVars -> Bool
forall a. Null a => a -> Bool
null LocalVars
locals) ]
    , [ Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"context =" Doc -> Doc -> Doc
<+> PrecedenceStack -> Doc
forall a. Pretty a => a -> Doc
pretty PrecedenceStack
ctx
      , Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"modules"
      ]
    , (Scope -> Doc) -> [Scope] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
4 (Doc -> Doc) -> (Scope -> Doc) -> Scope -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope -> Doc
forall a. Pretty a => a -> Doc
pretty) ([Scope] -> [Doc]) -> [Scope] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Map ModuleName Scope -> [Scope]
forall k a. Map k a -> [a]
Map.elems Map ModuleName Scope
mods
    ]

------------------------------------------------------------------------
-- * Boring instances
------------------------------------------------------------------------

instance KillRange ScopeInfo where
  killRange :: ScopeInfo -> ScopeInfo
killRange ScopeInfo
m = ScopeInfo
m

instance HasRange AbstractName where
  getRange :: AbstractName -> Range
getRange = QName -> Range
forall a. HasRange a => a -> Range
getRange (QName -> Range)
-> (AbstractName -> QName) -> AbstractName -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractName -> QName
anameName

instance SetRange AbstractName where
  setRange :: Range -> AbstractName -> AbstractName
setRange Range
r AbstractName
x = AbstractName
x { anameName :: QName
anameName = Range -> QName -> QName
forall a. SetRange a => Range -> a -> a
setRange Range
r (QName -> QName) -> QName -> QName
forall a b. (a -> b) -> a -> b
$ AbstractName -> QName
anameName AbstractName
x }

instance NFData Scope
instance NFData DataOrRecordModule
instance NFData NameSpaceId
instance NFData ScopeInfo
instance NFData KindOfName
instance NFData NameMapEntry
instance NFData BindingSource
instance NFData LocalVar
instance NFData NameSpace
instance NFData NameOrModule
instance NFData WhyInScope
instance NFData AbstractName
instance NFData NameMetadata
instance NFData AbstractModule
instance NFData ResolvedName
instance NFData AmbiguousNameReason