{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c== :: Scope -> Scope -> Bool
Eq, Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Scope] -> ShowS
$cshowList :: [Scope] -> ShowS
show :: Scope -> FilePath
$cshow :: Scope -> FilePath
showsPrec :: Int -> Scope -> ShowS
$cshowsPrec :: Int -> Scope -> ShowS
Show, 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
$cto :: forall x. Rep Scope x -> Scope
$cfrom :: forall x. Scope -> Rep Scope x
Generic)

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

allNameSpaces :: [NameSpaceId]
allNameSpaces :: [NameSpaceId]
allNameSpaces = [forall a. Bounded a => a
minBound..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 = forall a. a -> Maybe a -> a
fromMaybe forall a. HasCallStack => a
__IMPOSSIBLE__ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup NameSpaceId
ns 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 = forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
for (ScopeNameSpaces -> m ScopeNameSpaces
f forall a b. (a -> b) -> a -> b
$ Scope -> ScopeNameSpaces
scopeNameSpaces Scope
s) 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
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ScopeInfo] -> ShowS
$cshowList :: [ScopeInfo] -> ShowS
show :: ScopeInfo -> FilePath
$cshow :: ScopeInfo -> FilePath
showsPrec :: Int -> ScopeInfo -> ShowS
$cshowsPrec :: Int -> ScopeInfo -> ShowS
Show, 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
$cto :: forall x. Rep ScopeInfo x -> ScopeInfo
$cfrom :: forall x. ScopeInfo -> Rep ScopeInfo x
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
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NameMapEntry] -> ShowS
$cshowList :: [NameMapEntry] -> ShowS
show :: NameMapEntry -> FilePath
$cshow :: NameMapEntry -> FilePath
showsPrec :: Int -> NameMapEntry -> ShowS
$cshowsPrec :: Int -> NameMapEntry -> ShowS
Show, 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
$cto :: forall x. Rep NameMapEntry x -> NameMapEntry
$cfrom :: forall x. NameMapEntry -> Rep NameMapEntry x
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 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 forall a. Eq a => a -> a -> Bool
== ModuleName
c2 Bool -> Bool -> Bool
&& Map ModuleName Scope
m1 forall a. Eq a => a -> a -> Bool
== Map ModuleName Scope
m2 Bool -> Bool -> Bool
&& LocalVars
v1 forall a. Eq a => a -> a -> Bool
== LocalVars
v2 Bool -> Bool -> Bool
&& LocalVars
l1 forall a. Eq a => a -> a -> Bool
== LocalVars
l2 Bool -> Bool -> Bool
&& PrecedenceStack
p1 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
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BindingSource] -> ShowS
$cshowList :: [BindingSource] -> ShowS
show :: BindingSource -> FilePath
$cshow :: BindingSource -> FilePath
showsPrec :: Int -> BindingSource -> ShowS
$cshowsPrec :: Int -> BindingSource -> ShowS
Show, BindingSource -> BindingSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BindingSource -> BindingSource -> Bool
$c/= :: BindingSource -> BindingSource -> Bool
== :: BindingSource -> BindingSource -> Bool
$c== :: BindingSource -> BindingSource -> Bool
Eq, 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
$cto :: forall x. Rep BindingSource x -> BindingSource
$cfrom :: forall x. BindingSource -> Rep BindingSource x
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
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LocalVar] -> ShowS
$cshowList :: [LocalVar] -> ShowS
show :: LocalVar -> FilePath
$cshow :: LocalVar -> FilePath
showsPrec :: Int -> LocalVar -> ShowS
$cshowsPrec :: Int -> LocalVar -> ShowS
Show, 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
$cto :: forall x. Rep LocalVar x -> LocalVar
$cfrom :: forall x. LocalVar -> Rep LocalVar x
Generic)

instance Eq LocalVar where
  == :: LocalVar -> LocalVar -> Bool
(==) = forall a. Eq a => a -> a -> 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 = forall a. Ord a => a -> a -> Ordering
compare 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
_ []) = forall a. Pretty a => a -> Doc
pretty Name
x
  pretty (LocalVar Name
x BindingSource
_ [AbstractName]
xs) = Doc
"." forall a. Semigroup a => a -> a -> a
P.<> 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
_ = 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 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 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
_ []) = forall a. a -> Maybe a
Just Name
x
notShadowedLocal LocalVar
_ = 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a b. (a -> b) -> a -> b
$ \ (Name
c,LocalVar
x) -> (Name
c,) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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 = forall i o. Lens' i o -> LensMap i o
over Lens' LocalVars ScopeInfo
scopeVarsToBind

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

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

setScopeLocals :: LocalVars -> ScopeInfo -> ScopeInfo
setScopeLocals :: LocalVars -> ScopeInfo -> ScopeInfo
setScopeLocals = forall i o. Lens' i o -> LensSet i o
set 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameSpace -> NameSpace -> Bool
$c/= :: NameSpace -> NameSpace -> Bool
== :: NameSpace -> NameSpace -> Bool
$c== :: NameSpace -> NameSpace -> Bool
Eq, Int -> NameSpace -> ShowS
[NameSpace] -> ShowS
NameSpace -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NameSpace] -> ShowS
$cshowList :: [NameSpace] -> ShowS
show :: NameSpace -> FilePath
$cshow :: NameSpace -> FilePath
showsPrec :: Int -> NameSpace -> ShowS
$cshowsPrec :: Int -> NameSpace -> ShowS
Show, 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
$cto :: forall x. Rep NameSpace x -> NameSpace
$cfrom :: forall x. NameSpace -> Rep NameSpace x
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 forall a. InScope a => InScopeTag a
inScopeTag :: InScopeTag a of
  InScopeTag a
NameTag   -> NameSpace -> NamesInScope
nsNames
  InScopeTag a
ModuleTag -> NameSpace -> ModulesInScope
nsModules

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

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

isConName :: KindOfName -> Maybe Induction
isConName :: KindOfName -> Maybe Induction
isConName = \case
  KindOfName
ConName   -> forall a. a -> Maybe a
Just Induction
Inductive
  KindOfName
CoConName -> forall a. a -> Maybe a
Just Induction
CoInductive
  KindOfName
_ -> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. a -> Maybe a -> a
fromMaybe Induction
Inductive forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Induction
is of
  [Induction
CoInductive] -> forall a. a -> Maybe a
Just Induction
CoInductive
  [Induction
Inductive]   -> forall a. a -> Maybe a
Just Induction
Inductive
  [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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Induction -> KindOfName
conKindOfName forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Ord a => a -> Set a -> Bool
`Set.member` Set KindOfName
ks
  ExceptKindsOfNames Set KindOfName
ks -> KindOfName
k 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList

exceptKindsOfNames :: [KindOfName] -> KindsOfNames
exceptKindsOfNames :: [KindOfName] -> KindsOfNames
exceptKindsOfNames = Set KindOfName -> KindsOfNames
ExceptKindsOfNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
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
showList :: [WithKind a] -> ShowS
$cshowList :: forall a. Show a => [WithKind a] -> ShowS
show :: WithKind a -> FilePath
$cshow :: forall a. Show a => WithKind a -> FilePath
showsPrec :: Int -> WithKind a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> WithKind a -> ShowS
Show, WithKind a -> WithKind a -> Bool
forall a. Eq a => WithKind a -> WithKind a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithKind a -> WithKind a -> Bool
$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
Eq, WithKind a -> WithKind a -> Bool
WithKind a -> WithKind a -> Ordering
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
min :: WithKind a -> WithKind a -> WithKind a
$cmin :: forall a. Ord a => WithKind a -> WithKind a -> WithKind a
max :: WithKind a -> WithKind a -> WithKind a
$cmax :: forall a. Ord a => WithKind a -> WithKind a -> WithKind a
>= :: 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
$c< :: forall a. Ord a => WithKind a -> WithKind a -> Bool
compare :: WithKind a -> WithKind a -> Ordering
$ccompare :: forall a. Ord a => WithKind a -> WithKind a -> Ordering
Ord, 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
<$ :: forall a b. a -> WithKind b -> WithKind a
$c<$ :: forall a b. a -> WithKind b -> WithKind a
fmap :: forall a b. (a -> b) -> WithKind a -> WithKind b
$cfmap :: forall a b. (a -> b) -> WithKind a -> WithKind b
Functor, 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
product :: forall a. Num a => WithKind a -> a
$cproduct :: forall a. Num a => WithKind a -> a
sum :: forall a. Num a => WithKind a -> a
$csum :: forall a. Num a => WithKind a -> a
minimum :: forall a. Ord a => WithKind a -> a
$cminimum :: forall a. Ord a => WithKind a -> a
maximum :: forall a. Ord a => WithKind a -> a
$cmaximum :: forall a. Ord a => WithKind a -> a
elem :: forall a. Eq a => a -> WithKind a -> Bool
$celem :: forall a. Eq a => a -> WithKind a -> Bool
length :: forall a. WithKind a -> Int
$clength :: forall a. WithKind a -> Int
null :: forall a. WithKind a -> Bool
$cnull :: forall a. WithKind a -> Bool
toList :: forall a. WithKind a -> [a]
$ctoList :: forall a. WithKind a -> [a]
foldl1 :: forall a. (a -> a -> a) -> WithKind a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> WithKind a -> a
foldr1 :: forall a. (a -> a -> a) -> WithKind a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> WithKind a -> a
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
$cfoldl :: forall b a. (b -> a -> 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
$cfoldr :: forall a b. (a -> b -> b) -> b -> WithKind a -> b
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
$cfoldMap :: forall m a. Monoid m => (a -> m) -> WithKind a -> m
fold :: forall m. Monoid m => WithKind m -> m
$cfold :: forall m. Monoid m => WithKind m -> m
Foldable, Functor WithKind
Foldable 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)
sequence :: forall (m :: * -> *) a. Monad m => WithKind (m a) -> m (WithKind a)
$csequence :: forall (m :: * -> *) a. Monad m => WithKind (m a) -> m (WithKind a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithKind a -> m (WithKind b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithKind a -> m (WithKind b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithKind (f a) -> f (WithKind a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithKind (f a) -> f (WithKind a)
traverse :: 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)
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
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [WhyInScope] -> ShowS
$cshowList :: [WhyInScope] -> ShowS
show :: WhyInScope -> FilePath
$cshow :: WhyInScope -> FilePath
showsPrec :: Int -> WhyInScope -> ShowS
$cshowsPrec :: Int -> WhyInScope -> ShowS
Show, 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
$cto :: forall x. Rep WhyInScope x -> WhyInScope
$cfrom :: forall x. WhyInScope -> Rep WhyInScope x
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
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AbstractName] -> ShowS
$cshowList :: [AbstractName] -> ShowS
show :: AbstractName -> FilePath
$cshow :: AbstractName -> FilePath
showsPrec :: Int -> AbstractName -> ShowS
$cshowsPrec :: Int -> AbstractName -> ShowS
Show, 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
$cto :: forall x. Rep AbstractName x -> AbstractName
$cfrom :: forall x. AbstractName -> Rep AbstractName x
Generic)

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

instance Eq AbstractName where
  == :: AbstractName -> AbstractName -> Bool
(==) = forall a. Eq a => a -> a -> 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 = forall a. Ord a => a -> a -> Ordering
compare 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 = Lens' QName AbstractName
lensAnameName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LensFixity a => Lens' Fixity a
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) 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
(==) = forall a. Eq a => a -> a -> 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 = forall a. Ord a => a -> a -> Ordering
compare 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) 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
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ResolvedName] -> ShowS
$cshowList :: [ResolvedName] -> ShowS
show :: ResolvedName -> FilePath
$cshow :: ResolvedName -> FilePath
showsPrec :: Int -> ResolvedName -> ShowS
$cshowsPrec :: Int -> ResolvedName -> ShowS
Show, ResolvedName -> ResolvedName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResolvedName -> ResolvedName -> Bool
$c/= :: ResolvedName -> ResolvedName -> Bool
== :: ResolvedName -> ResolvedName -> Bool
$c== :: ResolvedName -> ResolvedName -> Bool
Eq, 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
$cto :: forall x. Rep ResolvedName x -> ResolvedName
$cfrom :: forall x. ResolvedName -> Rep ResolvedName x
Generic)

instance Pretty ResolvedName where
  pretty :: ResolvedName -> Doc
pretty = \case
    VarName Name
x BindingSource
b          -> forall a. Pretty a => a -> Doc
pretty BindingSource
b Doc -> Doc -> Doc
<+> Doc
"variable" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty Name
x
    DefinedName Access
a AbstractName
x Suffix
s    -> forall a. Pretty a => a -> Doc
pretty Access
a      Doc -> Doc -> Doc
<+> (forall a. Pretty a => a -> Doc
pretty AbstractName
x forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty Suffix
s)
    FieldName List1 AbstractName
xs         -> Doc
"field"       Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty List1 AbstractName
xs
    ConstructorName Set Induction
_ List1 AbstractName
xs -> Doc
"constructor" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty List1 AbstractName
xs
    PatternSynResName List1 AbstractName
x  -> Doc
"pattern"     Doc -> Doc -> 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   = forall a. Monoid a => a
mempty
  pretty (Suffix Integer
i) = FilePath -> Doc
text (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
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AmbiguousNameReason] -> ShowS
$cshowList :: [AmbiguousNameReason] -> ShowS
show :: AmbiguousNameReason -> FilePath
$cshow :: AmbiguousNameReason -> FilePath
showsPrec :: Int -> AmbiguousNameReason -> ShowS
$cshowsPrec :: Int -> AmbiguousNameReason -> ShowS
Show, 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
$cto :: forall x. Rep AmbiguousNameReason x -> AmbiguousNameReason
$cfrom :: forall x. AmbiguousNameReason -> Rep AmbiguousNameReason x
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 -> forall a. a -> List1 a -> List2 a
List2.cons (Name -> QName
A.qualify_ Name
y) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AbstractName -> QName
anameName List1 AbstractName
xs
  AmbiguousDeclName List2 AbstractName
xs -> 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 forall a. Null a => a
empty (forall a. a -> Maybe a
Just LocalVar
x) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List1 AbstractName
ys) forall a. Null a => a
empty
  AmbiguousDeclName List2 AbstractName
ys   -> QName
-> FilePath
-> Maybe LocalVar
-> [AbstractName]
-> [AbstractModule]
-> WhyInScopeData
WhyInScopeData QName
q forall a. Null a => a
empty forall a. Maybe a
Nothing  (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List2 AbstractName
ys) 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 = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith 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 = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith 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 forall k a. Map k a
Map.empty forall k a. Map k a
Map.empty 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 forall a b. (a -> b) -> a -> b
$ NameSpace -> NamesInScope
nsNames   NameSpace
ns
     , nsModules :: ModulesInScope
nsModules = ModulesInScope -> ModulesInScope
fm forall a b. (a -> b) -> a -> b
$ NameSpace -> ModulesInScope
nsModules NameSpace
ns
     , nsInScope :: InScopeSet
nsInScope = InScopeSet -> InScopeSet
fs 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesInScope -> m NamesInScope
fd (NameSpace -> NamesInScope
nsNames NameSpace
ns) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ModulesInScope -> m ModulesInScope
fm (NameSpace -> ModulesInScope
nsModules NameSpace
ns) 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  = 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  = 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        = forall k a. Map k a
Map.empty
  , scopeDatatypeModule :: Maybe DataOrRecordModule
scopeDatatypeModule = 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       = 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   = forall k a. Map k a
Map.empty
  , _scopeInverseModule :: ModuleMap
_scopeInverseModule = forall k a. Map k a
Map.empty
  , _scopeInScope :: InScopeSet
_scopeInScope       = forall a. Set a
Set.empty
  , _scopeFixities :: Fixities
_scopeFixities      = forall k a. Map k a
Map.empty
  , _scopePolarities :: Polarities
_scopePolarities    = 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 forall a b. (a -> b) -> a -> b
$ 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 (forall a b. a -> b -> a
const NamesInScope -> NamesInScope
fd) (forall a b. a -> b -> a
const ModulesInScope -> ModulesInScope
fm) (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 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 = forall (m :: * -> *).
Functor m =>
(ScopeNameSpaces -> m ScopeNameSpaces) -> Scope -> m Scope
updateScopeNameSpacesM forall a b. (a -> b) -> a -> b
$ 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 = 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 = forall (m :: * -> *).
Applicative m =>
(NameSpaceId -> NamesInScope -> m NamesInScope)
-> (NameSpaceId -> ModulesInScope -> m ModulesInScope)
-> (NameSpaceId -> InScopeSet -> m InScopeSet)
-> Scope
-> m Scope
mapScopeM (forall a b. a -> b -> a
const NamesInScope -> m NamesInScope
fd) (forall a b. a -> b -> a
const ModulesInScope -> m ModulesInScope
fm) (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)) <-
             forall a. a -> Maybe a -> a
fromMaybe forall a. HasCallStack => a
__IMPOSSIBLE__ forall a b. (a -> b) -> a -> b
$
               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 forall a. Eq a => a -> a -> Bool
== NameSpaceId
nsid')
         ]
     , scopeImports :: Map QName ModuleName
scopeImports  = (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union 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 = 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 (forall a b. a -> b -> a
const NamesInScope -> NamesInScope -> NamesInScope
fd) (forall a b. a -> b -> a
const ModulesInScope -> ModulesInScope -> ModulesInScope
fm) (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 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ NameSpace -> NamesInScope
nsNames NameSpace
ns }
    allANames :: NamesInScope -> InScopeSet
    allANames :: NamesInScope -> InScopeSet
allANames = forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map AbstractName -> QName
anameName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (NamesInScope -> NamesInScope)
-> (ModulesInScope -> ModulesInScope)
-> (InScopeSet -> InScopeSet)
-> Scope
-> Scope
mapScope_ (forall k a. (k -> Bool) -> Map k a -> Map k a
Map.filterKeys Name -> Bool
pd) (forall k a. (k -> Bool) -> Map k a -> Map k a
Map.filterKeys Name -> Bool
pm) 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 = forall a. Eq a => [ThingsInScope a] -> ThingsInScope a
mergeNamesMany forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. InScope a => NameSpace -> ThingsInScope a
inNameSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) 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 =
  forall a. Eq a => [ThingsInScope a] -> ThingsInScope a
mergeNamesMany [ forall a b. (a -> b) -> [a] -> [b]
map (, NameSpaceId -> Access
nameSpaceAccess NameSpaceId
nsId) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Name
n forall a b. (a -> b) -> a -> b
$ 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 = 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 =
  forall a. Eq a => [ThingsInScope a] -> ThingsInScope a
mergeNamesMany [ 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   = forall a. InScope a => Scope -> ThingsInScope a
allNamesInScope Scope
s
            , nsModules :: ModulesInScope
nsModules = forall a. InScope a => Scope -> ThingsInScope a
allNamesInScope Scope
s
            , nsInScope :: InScopeSet
nsInScope = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (NameSpace -> InScopeSet
nsInScope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) 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   = forall a. InScope a => [NameSpaceId] -> Scope -> ThingsInScope a
namesInScope [NameSpaceId]
fs Scope
s
            , nsModules :: ModulesInScope
nsModules = forall a. InScope a => [NameSpaceId] -> Scope -> ThingsInScope a
namesInScope [NameSpaceId]
fs Scope
s
            , nsInScope :: InScopeSet
nsInScope = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [ NameSpace -> InScopeSet
nsInScope 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_ forall a.
Eq a =>
ThingsInScope a -> ThingsInScope a -> ThingsInScope a
mergeNames forall a.
Eq a =>
ThingsInScope a -> ThingsInScope a -> ThingsInScope a
mergeNames 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 [] = forall a. HasCallStack => a
__IMPOSSIBLE__
mergeScopes [Scope]
ss = 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) forall a b. (a -> b) -> a -> b
$ forall k v. (k -> v -> v) -> AssocList k v -> AssocList k v
AssocList.mapWithKey forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const 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 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ 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
    (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Eq a => [a] -> [a] -> [a]
List.union) Name
x [AbstractName
y])  -- bind name x ↦ y
    forall a. a -> a
id                                        -- no change to modules
    (forall a. Ord a => a -> Set a -> Set a
Set.insert 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 (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Name
x) forall a. a -> a
id 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 forall a. a -> a
id ModulesInScope -> ModulesInScope
addM forall a. a -> a
id
  where addM :: ModulesInScope -> ModulesInScope
addM = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 (forall n m. ImportDirective' n m -> Using' n m
using ImportDirective
i, 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)
_                   -> 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 = forall a b. (a, b) -> a
fst 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 :: forall n m. ImportDirective' n m -> RenamingDirective' n m
impRenaming :: RenamingDirective' Name Name
impRenaming }) Scope
s
  | forall a. Null a => a -> Bool
null ImportDirective
dir  = (Scope
s, (forall a. Null a => a
empty, 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 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 = forall k a. Map k a -> Set k
Map.keysSet NamesInScope
rNames forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` 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 = forall a. InScope a => [NameSpaceId] -> Scope -> ThingsInScope a
namesInScope [NameSpaceId]
exportedNSs Scope
sUse
      rNames :: NamesInScope
rNames = 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 = forall k a. Map k a -> Set k
Map.keysSet ModulesInScope
uModules forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` forall k a. Map k a -> Set k
Map.keysSet ModulesInScope
rModules
      where
      uModules, rModules :: ModulesInScope
      uModules :: ModulesInScope
uModules = forall a. InScope a => [NameSpaceId] -> Scope -> ThingsInScope a
namesInScope [NameSpaceId]
exportedNSs Scope
sUse
      rModules :: ModulesInScope
rModules = 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 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 forall a. Ord a => a -> Set a -> Bool
Set.notMember forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall n m. Renaming' n m -> ImportedName' n m
renFrom RenamingDirective' Name Name
impRenaming 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` forall a. Ord a => [a] -> Set a
Set.fromList [Name]
ds) (Name -> Set Name -> Bool
`rel` forall a. Ord a => [a] -> Set a
Set.fromList [Name]
ms)
      where
        ([Name]
ds, [Name]
ms) = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
for HidingDirective' Name Name
xs forall a b. (a -> b) -> a -> b
$ \case
          ImportedName   Name
x -> forall a b. a -> Either a b
Left Name
x
          ImportedModule Name
m -> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            forall a.
SetBindingSite a =>
(Name -> Maybe Name) -> ThingsInScope a -> ThingsInScope a
updateThingsInScope (forall k v. Ord k => AssocList k v -> k -> Maybe v
AssocList.apply [(Name, Name)]
drho))
                           (forall a.
SetBindingSite a =>
(Name -> Maybe Name) -> ThingsInScope a -> ThingsInScope a
updateThingsInScope (forall k v. Ord k => AssocList k v -> k -> Maybe v
AssocList.apply [(Name, Name)]
mrho))
                           forall a. a -> a
id
      where
        ([(Name, Name)]
drho, [(Name, Name)]
mrho) = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
for RenamingDirective' Name Name
rho forall a b. (a -> b) -> a -> b
$ \case
          Renaming (ImportedName   Name
x) (ImportedName   Name
y) Maybe Fixity
_fx Range
_ -> forall a b. a -> Either a b
Left  (Name
x, Name
y)
          Renaming (ImportedModule Name
x) (ImportedModule Name
y) Maybe Fixity
_fx Range
_ -> forall a b. b -> Either a b
Right (Name
x, Name
y)
          Renaming
_ -> forall a. HasCallStack => a
__IMPOSSIBLE__

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

        -- Update fixities of abstract names targeted by renamed imported identifies.
        updateFxs :: NamesInScope -> NamesInScope
        updateFxs :: NamesInScope -> NamesInScope
updateFxs NamesInScope
m = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl 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) = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ forall i o. Lens' i o -> LensSet i o
set forall a. LensFixity 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 = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. HasCallStack => a
__IMPOSSIBLE__ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Name, [a]) -> Maybe (Name, [a])
upd forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall (m :: * -> *) a b. Functor m => m a -> (a -> b) -> m b
<&> \ Name
x' -> (Name
x', forall a. SetBindingSite a => Range -> a -> a
setBindingSite (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 (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map QName -> QName
newName)
  where
    newName :: QName -> QName
newName QName
x = 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 = 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 = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ forall i o. Lens' i o -> LensMap i o
over Lens' QName AbstractName
lensAnameName QName -> QName
newName
    renameM :: ModulesInScope -> ModulesInScope
renameM = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ forall i o. Lens' i o -> LensMap i o
over 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
                  forall a b. (a -> b) -> a -> b
$ Scope
s { scopeImports :: Map QName ModuleName
scopeImports = 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
    (forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe [AbstractName] -> Maybe [AbstractName]
rName)
    (forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe [AbstractModule] -> Maybe [AbstractModule]
rMod)
    (forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> ModuleName -> Bool
`isInModule` ModuleName
m)))
  where
    rName :: [AbstractName] -> Maybe [AbstractName]
rName [AbstractName]
as = forall a. (a -> Bool) -> a -> Maybe a
filterMaybe (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Null a => a -> Bool
null) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> ModuleName -> Bool
`isInModule`        ModuleName
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractName -> QName
anameName) [AbstractName]
as
    rMod :: [AbstractModule] -> Maybe [AbstractModule]
rMod  [AbstractModule]
as = forall a. (a -> Bool) -> a -> Maybe a
filterMaybe (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Null a => a -> Bool
null) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName -> ModuleName -> Bool
`isLtChildModuleOf` ModuleName
m) 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 = forall i o. Lens' i o -> LensMap i o
over Lens' (Map ModuleName Scope) ScopeInfo
scopeModules (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ ModuleName -> Scope -> Scope
restrictLocalPrivate ModuleName
m) ScopeInfo
scope
  where
  m :: ModuleName
m = ScopeInfo
scope forall o i. o -> Lens' i o -> i
^. 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_ ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) AbstractName -> AbstractName
disallow) forall a. a -> a
id 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 forall a. a -> a
id
  where
    mapName :: NamesInScope -> NamesInScope
mapName = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ \AbstractName
a -> AbstractName
a { anameLineage :: WhyInScope
anameLineage = WhyInScope -> WhyInScope
f forall a b. (a -> b) -> a -> b
$ AbstractName -> WhyInScope
anameLineage AbstractName
a }
    mapMod :: ModulesInScope -> ModulesInScope
mapMod  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ \AbstractModule
a -> AbstractModule
a { amodLineage :: WhyInScope
amodLineage  = WhyInScope -> WhyInScope
f 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 = 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   = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Scope -> Scope
restrictPrivate forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope forall o i. o -> Lens' i o -> i
^. Lens' (Map ModuleName Scope) ScopeInfo
scopeModules
    root :: ModuleName
root      = ScopeInfo
scope forall o i. o -> Lens' i o -> i
^. Lens' ModuleName ScopeInfo
scopeCurrent

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

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

    reachable :: ModuleName -> Bool
reachable = (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 =
  forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$
  forall a. InScope a => Scope -> ThingsInScope a
exportedNamesInScope forall a b. (a -> b) -> a -> b
$ [Scope] -> Scope
mergeScopes forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems 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 forall a b. (a -> b) -> a -> b
$ [Scope] -> Scope
mergeScopes forall a b. (a -> b) -> a -> b
$
    (Scope
s0 forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> Scope
look forall a b. (a -> b) -> a -> b
$ Scope -> [ModuleName]
scopeParents Scope
s0
  where
    look :: ModuleName -> Scope
look ModuleName
m = forall a. a -> Maybe a -> a
fromMaybe forall a. HasCallStack => a
__IMPOSSIBLE__ forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
m forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope forall o i. o -> Lens' i o -> i
^. Lens' (Map ModuleName Scope) ScopeInfo
scopeModules
    s0 :: Scope
s0     = ModuleName -> Scope
look forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope forall o i. o -> Lens' i o -> i
^. Lens' ModuleName ScopeInfo
scopeCurrent

everythingInScopeQualified :: ScopeInfo -> NameSpace
everythingInScopeQualified :: ScopeInfo -> NameSpace
everythingInScopeQualified ScopeInfo
scope =
  Scope -> NameSpace
allThingsInScope forall a b. (a -> b) -> a -> b
$ [Scope] -> Scope
mergeScopes forall a b. (a -> b) -> a -> b
$
    Set ModuleName -> [Scope] -> [Scope]
chase forall a. Set a
Set.empty [Scope]
scopes
  where
    s0 :: Scope
s0      = ModuleName -> Scope
look forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope forall o i. o -> Lens' i o -> i
^. Lens' ModuleName ScopeInfo
scopeCurrent
    scopes :: [Scope]
scopes  = Scope
s0 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> Scope
look (Scope -> [ModuleName]
scopeParents Scope
s0)
    look :: ModuleName -> Scope
look ModuleName
m  = forall a. a -> Maybe a -> a
fromMaybe forall a. HasCallStack => a
__IMPOSSIBLE__ forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
m forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope forall o i. o -> Lens' i o -> i
^. Lens' (Map ModuleName Scope) ScopeInfo
scopeModules
    lookP :: ModuleName -> Scope
lookP   = Scope -> Scope
restrictPrivate 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)
      | 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 forall a. a -> [a] -> [a]
: Set ModuleName -> [Scope] -> [Scope]
chase (forall a. Ord a => a -> Set a -> Set a
Set.insert ModuleName
name Set ModuleName
seen) ([Scope]
imports forall a. [a] -> [a] -> [a]
++ [Scope]
submods 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
_ = forall a. LensInScope a => a -> NameInScope
isInScope a
x forall a. Eq a => a -> a -> Bool
== NameInScope
InScope
        name :: ModuleName
name    = Scope -> ModuleName
scopeName Scope
s
        imports :: [Scope]
imports = forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> Scope
lookP forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ Scope -> Map QName ModuleName
scopeImports Scope
s
        submods :: [Scope]
submods = forall a b. (a -> b) -> [a] -> [b]
map (ModuleName -> Scope
lookP forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractModule -> ModuleName
amodName) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey forall {a} {p}. LensInScope a => a -> p -> Bool
inscope forall a b. (a -> b) -> a -> b
$ 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 =
  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 forall a. InScope a => Scope -> ThingsInScope a
allNamesInScope Scope
root, Set QName
imported, Set QName
locals ]
  where
    current :: Scope
current = ModuleName -> Scope
moduleScope forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope forall o i. o -> Lens' i o -> i
^. Lens' ModuleName ScopeInfo
scopeCurrent
    root :: Scope
root    = [Scope] -> Scope
mergeScopes forall a b. (a -> b) -> a -> b
$ Scope
current forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> Scope
moduleScope (Scope -> [ModuleName]
scopeParents Scope
current)

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

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

    moduleScope :: A.ModuleName -> Scope
    moduleScope :: ModuleName -> Scope
moduleScope ModuleName
m = forall a. a -> Maybe a -> a
fromMaybe forall a. HasCallStack => a
__IMPOSSIBLE__ forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
m forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope forall o i. o -> Lens' i o -> i
^. 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 = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ 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 =
  forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOn forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
    forall a. InScope a => QName -> Scope -> [(a, Access)]
findName QName
q Scope
root forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe (a, Access)
topImports 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 = forall a. a -> Maybe a -> a
fromMaybe forall a. HasCallStack => a
__IMPOSSIBLE__ forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
m forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope forall o i. o -> Lens' i o -> i
^. Lens' (Map ModuleName Scope) ScopeInfo
scopeModules

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

    root    :: Scope
    root :: Scope
root    = [Scope] -> Scope
mergeScopes forall a b. (a -> b) -> a -> b
$ Scope
current forall a. a -> [a] -> [a]
: 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  -> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractName -> QName
anameName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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  = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
m forall a b. (a -> b) -> a -> b
$ ScopeInfo
scope forall o i. o -> Lens' i o -> i
^. Lens' (Map ModuleName Scope) ScopeInfo
scopeModules
            ss' :: Maybe Scope
ss' = Scope -> Scope
restrictPrivate 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' <- forall a. Maybe a -> [a]
maybeToList Maybe Scope
ss'
        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 (forall a. InScope a => InScopeTag a
inScopeTag :: InScopeTag a) of
      InScopeTag a
NameTag   -> forall a. Maybe a
Nothing
      InScopeTag a
ModuleTag -> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (ModuleName -> WhyInScope -> AbstractModule
`AbsModule` WhyInScope
Defined) 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Access
PublicAccess) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
q 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 <- forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Maybe (ModuleName, Access)
imported QName
m
      forall a. InScope a => QName -> Scope -> [(a, Access)]
findName QName
x forall a b. (a -> b) -> a -> b
$ Scope -> Scope
restrictPrivate 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) 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllowAmbiguousNames -> AllowAmbiguousNames -> Bool
$c/= :: AllowAmbiguousNames -> AllowAmbiguousNames -> Bool
== :: AllowAmbiguousNames -> AllowAmbiguousNames -> Bool
$c== :: AllowAmbiguousNames -> AllowAmbiguousNames -> Bool
Eq)

isNameInScope :: A.QName -> ScopeInfo -> Bool
isNameInScope :: QName -> ScopeInfo -> Bool
isNameInScope QName
q ScopeInfo
scope =
  forall a. Account -> a -> a
billToPure [ Phase
Scoping, Phase
InverseScopeLookup ] forall a b. (a -> b) -> a -> b
$
  forall a. Ord a => a -> Set a -> Bool
Set.member QName
q (ScopeInfo
scope forall o i. o -> Lens' i o -> i
^. 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 =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall l. IsList l => l -> [Item l]
List1.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameMapEntry -> List1 QName
qnameConcrete) 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 = forall a. Account -> a -> a
billToPure [ Phase
Scoping , Phase
InverseScopeLookup ] forall a b. (a -> b) -> a -> b
$ do
  NameMapEntry KindOfName
k List1 QName
xs <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
q (ScopeInfo
scope forall o i. o -> Lens' i o -> i
^. Lens' NameMap ScopeInfo
scopeInverseName)
  KindOfName -> List1 QName -> NameMapEntry
NameMapEntry KindOfName
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do forall a. [a] -> Maybe (NonEmpty a)
List1.nonEmpty forall a b. (a -> b) -> a -> b
$ [QName] -> [QName]
best forall a b. (a -> b) -> a -> b
$ 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 = forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> List1 Name
C.qnameParts

    unique :: forall a . [a] -> Bool
    unique :: forall a. [a] -> Bool
unique []      = 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 = forall (t :: * -> *). Foldable t => t Bool -> Bool
or
      [ AllowAmbiguousNames
amb forall a. Eq a => a -> a -> Bool
== AllowAmbiguousNames
AmbiguousAnything
      , forall a. [a] -> Bool
unique [AbstractName]
xs
      , AllowAmbiguousNames
amb forall a. Eq a => a -> a -> Bool
== AllowAmbiguousNames
AmbiguousConProjs Bool -> Bool -> Bool
&& forall (t :: * -> *). Foldable t => t Bool -> Bool
or
          [ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindOfName -> Maybe Induction
isConName) (KindOfName
kforall a. a -> [a] -> [a]
:[KindOfName]
ks)
          , KindOfName
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ KindOfName
FldName, KindOfName
PatternSynName ] Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (KindOfName
k forall a. Eq a => a -> a -> Bool
==) [KindOfName]
ks
          ]
      ]
      where
      xs :: [AbstractName]
xs   = forall a. InScope a => QName -> ScopeInfo -> [a]
scopeLookup QName
q ScopeInfo
scope
      KindOfName
k:[KindOfName]
ks = 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 = forall a. Account -> a -> a
billToPure [ Phase
Scoping , Phase
InverseScopeLookup ] forall a b. (a -> b) -> a -> b
$
  [QName] -> [QName]
best forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter QName -> Bool
unambiguousModule forall a b. (a -> b) -> a -> b
$ ModuleName -> [QName]
findModule ModuleName
m
  where
    findModule :: ModuleName -> [QName]
findModule ModuleName
m = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
m (ScopeInfo
scope forall o i. o -> Lens' i o -> i
^. Lens' ModuleMap ScopeInfo
scopeInverseModule)

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

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

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

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

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

    restrict :: ModuleName -> Scope -> Scope
restrict ModuleName
m Scope
s | ModuleName
m 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) <- forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
q Map a [(ModuleName, Name)]
table
      if ModuleName
m forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ModuleName]
current
        then 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
          forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ QName -> Bool
internalName QName
z
          forall (m :: * -> *) a. Monad m => a -> m a
return QName
z

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

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

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

    nameMap :: NameMap
    nameMap :: NameMap
nameMap = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$ do
      (ModuleName
m, Scope
s)  <- [(ModuleName, Scope)]
scopes
      (Name
x, [AbstractName]
ms) <- forall k a. Map k a -> [(k, a)]
Map.toList (forall a. InScope a => Scope -> ThingsInScope a
allNamesInScope Scope
s)
      (QName
q, KindOfName
k)  <- (AbstractName -> QName
anameName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& AbstractName -> KindOfName
anameKind) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AbstractName]
ms
      let ret :: QName -> [(QName, NameMapEntry)]
ret QName
z = forall (m :: * -> *) a. Monad m => a -> m a
return (QName
q, KindOfName -> List1 QName -> NameMapEntry
NameMapEntry KindOfName
k forall a b. (a -> b) -> a -> b
$ forall el coll. Singleton el coll => el -> coll
singleton QName
z)
      if ModuleName
m forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ModuleName]
current
        then QName -> [(QName, NameMapEntry)]
ret 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
          forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. SetBindingSite a => Range -> a -> a
setBindingSite Range
r 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 forall a b. (a -> b) -> a -> b
$ 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 = forall a. SetBindingSite a => Range -> a -> a
setBindingSite Range
r 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 = forall a. SetBindingSite a => Range -> a -> a
setBindingSite Range
r forall a b. (a -> b) -> a -> b
$ AbstractModule -> ModuleName
amodName AbstractModule
x }


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

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

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

instance Pretty NameSpaceId where
  pretty :: NameSpaceId -> Doc
pretty = FilePath -> Doc
text 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 = forall (t :: * -> *). Foldable t => t Doc -> Doc
vcat 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"   (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Pretty a, Pretty b) => (a, b) -> Doc
pr forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList NamesInScope
names) forall a. [a] -> [a] -> [a]
++
    Doc -> [Doc] -> [Doc]
blockOfLines Doc
"modules" (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Pretty a, Pretty b) => (a, b) -> Doc
pr forall a b. (a -> b) -> a -> b
$ 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) = forall a. Pretty a => a -> Doc
pretty a
x Doc -> Doc -> Doc
<+> Doc
"-->" Doc -> Doc -> 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 } =
    forall (t :: * -> *). Foldable t => t Doc -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [ Doc
"scope" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty ModuleName
name ]
      , Scope -> ScopeNameSpaces
scopeNameSpaces Scope
scope forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (NameSpaceId
nsid, NameSpace
ns) -> do
          Doc -> [Doc] -> [Doc]
block (forall a. Pretty a => a -> Doc
pretty NameSpaceId
nsid) forall a b. (a -> b) -> a -> b
$ NameSpace -> [Doc]
prettyNameSpace NameSpace
ns
      , forall a b. Null a => a -> b -> (a -> b) -> b
ifNull (forall k a. Map k a -> [k]
Map.keys Map QName ModuleName
imps) [] {-else-} forall a b. (a -> b) -> a -> b
$ \ [QName]
ks ->
          Doc -> [Doc] -> [Doc]
block Doc
"imports" [ forall a. Pretty a => [a] -> Doc
prettyList [QName]
ks ]
      ]
    where
    block :: Doc -> [Doc] -> [Doc]
    block :: Doc -> [Doc] -> [Doc]
block Doc
hd = forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2) 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 forall a. a -> [a] -> [a]
: 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
_) = forall (t :: * -> *). Foldable t => t Doc -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [ Doc
"ScopeInfo"
      , Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ Doc
"current =" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty ModuleName
this
      ]
    , [ Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ Doc
"toBind  =" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty LocalVars
locals | Bool -> Bool
not (forall a. Null a => a -> Bool
null LocalVars
toBind) ]
    , [ Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ Doc
"locals  =" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty LocalVars
locals | Bool -> Bool
not (forall a. Null a => a -> Bool
null LocalVars
locals) ]
    , [ Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ Doc
"context =" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty PrecedenceStack
ctx
      , Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ Doc
"modules"
      ]
    , forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty) forall a b. (a -> b) -> a -> b
$ 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 = forall a. HasRange a => a -> Range
getRange 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 = forall a. SetRange a => Range -> a -> a
setRange Range
r 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