module Agda.Syntax.Scope.Base where
import Control.Arrow ((***), first, second)
import Control.Applicative
import Control.DeepSeq
import Data.Function
import Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Data.Typeable (Typeable)
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 Agda.Syntax.Concrete
(ImportDirective(..), UsingOrHiding(..), ImportedName(..), Renaming(..))
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 qualified Agda.Utils.Map as Map
#include "undefined.h"
import Agda.Utils.Impossible
data Scope = Scope
{ scopeName :: A.ModuleName
, scopeParents :: [A.ModuleName]
, scopeNameSpaces :: ScopeNameSpaces
, scopeImports :: Map C.QName A.ModuleName
, scopeDatatypeModule :: Bool
}
deriving (Typeable)
data NameSpaceId
= PrivateNS
| PublicNS
| ImportedNS
| OnlyQualifiedNS
deriving (Typeable, Eq, Bounded, Enum)
type ScopeNameSpaces = [(NameSpaceId, NameSpace)]
localNameSpace :: Access -> NameSpaceId
localNameSpace PublicAccess = PublicNS
localNameSpace PrivateAccess = PrivateNS
localNameSpace OnlyQualified = OnlyQualifiedNS
nameSpaceAccess :: NameSpaceId -> Access
nameSpaceAccess PrivateNS = PrivateAccess
nameSpaceAccess _ = PublicAccess
scopeNameSpace :: NameSpaceId -> Scope -> NameSpace
scopeNameSpace ns = fromMaybe __IMPOSSIBLE__ . lookup ns . scopeNameSpaces
updateScopeNameSpaces :: (ScopeNameSpaces -> ScopeNameSpaces) -> Scope -> Scope
updateScopeNameSpaces f s = s { scopeNameSpaces = f (scopeNameSpaces s) }
updateScopeNameSpacesM ::
(Functor m) => (ScopeNameSpaces -> m ScopeNameSpaces) -> Scope -> m Scope
updateScopeNameSpacesM f s = for (f $ scopeNameSpaces s) $ \ x ->
s { scopeNameSpaces = x }
data ScopeInfo = ScopeInfo
{ scopeCurrent :: A.ModuleName
, scopeModules :: Map A.ModuleName Scope
, scopeLocals :: LocalVars
, scopePrecedence :: Precedence
}
deriving (Typeable)
type LocalVars = AssocList C.Name LocalVar
data LocalVar
= LocalVar { localVar :: A.Name }
| ShadowedVar { localVar :: A.Name, localShadowedBy :: [AbstractName] }
deriving (Typeable)
instance NFData LocalVar where rnf x = seq x ()
instance Eq LocalVar where
(==) = (==) `on` localVar
instance Ord LocalVar where
compare = compare `on` localVar
instance Show LocalVar where
show (LocalVar x) = show x
show (ShadowedVar x xs) = "." ++ show x
shadowLocal :: [AbstractName] -> LocalVar -> LocalVar
shadowLocal [] _ = __IMPOSSIBLE__
shadowLocal ys (LocalVar x ) = ShadowedVar x ys
shadowLocal ys (ShadowedVar x zs) = ShadowedVar x (ys ++ zs)
notShadowedLocal :: LocalVar -> Maybe A.Name
notShadowedLocal (LocalVar x) = Just x
notShadowedLocal ShadowedVar{} = Nothing
notShadowedLocals :: LocalVars -> AssocList C.Name A.Name
notShadowedLocals = mapMaybe $ \ (c,x) -> (c,) <$> notShadowedLocal x
updateScopeLocals :: (LocalVars -> LocalVars) -> ScopeInfo -> ScopeInfo
updateScopeLocals f sc = sc { scopeLocals = f (scopeLocals sc) }
setScopeLocals :: LocalVars -> ScopeInfo -> ScopeInfo
setScopeLocals vars = updateScopeLocals (const vars)
data NameSpace = NameSpace
{ nsNames :: NamesInScope
, nsModules :: ModulesInScope
}
deriving (Typeable)
type ThingsInScope a = Map C.Name [a]
type NamesInScope = ThingsInScope AbstractName
type ModulesInScope = ThingsInScope AbstractModule
data InScopeTag a where
NameTag :: InScopeTag AbstractName
ModuleTag :: InScopeTag AbstractModule
class Eq a => InScope a where
inScopeTag :: InScopeTag a
instance InScope AbstractName where
inScopeTag = NameTag
instance InScope AbstractModule where
inScopeTag = ModuleTag
inNameSpace :: forall a. InScope a => NameSpace -> ThingsInScope a
inNameSpace = case inScopeTag :: InScopeTag a of
NameTag -> nsNames
ModuleTag -> nsModules
data KindOfName
= ConName
| FldName
| DefName
| PatternSynName
| QuotableName
deriving (Eq, Show, Typeable, Enum, Bounded)
allKindsOfNames :: [KindOfName]
allKindsOfNames = [minBound..maxBound]
data WhyInScope
= Defined
| Opened C.QName WhyInScope
| Applied C.QName WhyInScope
deriving (Typeable)
data AbstractName = AbsName
{ anameName :: A.QName
, anameKind :: KindOfName
, anameLineage :: WhyInScope
}
deriving (Typeable)
data AbstractModule = AbsModule
{ amodName :: A.ModuleName
, amodLineage :: WhyInScope
}
deriving (Typeable)
instance Eq AbstractName where
(==) = (==) `on` anameName
instance Ord AbstractName where
compare = compare `on` anameName
lensAnameName :: Functor m => (A.QName -> m A.QName) -> AbstractName -> m AbstractName
lensAnameName f am = f (anameName am) <&> \ m -> am { anameName = m }
instance Eq AbstractModule where
(==) = (==) `on` amodName
instance Ord AbstractModule where
compare = compare `on` amodName
lensAmodName :: Functor m => (A.ModuleName -> m A.ModuleName) -> AbstractModule -> m AbstractModule
lensAmodName f am = f (amodName am) <&> \ m -> am { amodName = m }
mergeNames :: Eq a => ThingsInScope a -> ThingsInScope a -> ThingsInScope a
mergeNames = Map.unionWith union
emptyNameSpace :: NameSpace
emptyNameSpace = NameSpace Map.empty Map.empty
mapNameSpace :: (NamesInScope -> NamesInScope ) ->
(ModulesInScope -> ModulesInScope) ->
NameSpace -> NameSpace
mapNameSpace fd fm ns =
ns { nsNames = fd $ nsNames ns
, nsModules = fm $ nsModules ns
}
zipNameSpace :: (NamesInScope -> NamesInScope -> NamesInScope ) ->
(ModulesInScope -> ModulesInScope -> ModulesInScope) ->
NameSpace -> NameSpace -> NameSpace
zipNameSpace fd fm ns1 ns2 =
ns1 { nsNames = nsNames ns1 `fd` nsNames ns2
, nsModules = nsModules ns1 `fm` nsModules ns2
}
mapNameSpaceM :: Applicative m =>
(NamesInScope -> m NamesInScope ) ->
(ModulesInScope -> m ModulesInScope) ->
NameSpace -> m NameSpace
mapNameSpaceM fd fm ns = update ns <$> fd (nsNames ns) <*> fm (nsModules ns)
where
update ns ds ms = ns { nsNames = ds, nsModules = ms }
emptyScope :: Scope
emptyScope = Scope
{ scopeName = noModuleName
, scopeParents = []
, scopeNameSpaces = [ (nsid, emptyNameSpace) | nsid <- [minBound..maxBound] ]
, scopeImports = Map.empty
, scopeDatatypeModule = False
}
emptyScopeInfo :: ScopeInfo
emptyScopeInfo = ScopeInfo
{ scopeCurrent = noModuleName
, scopeModules = Map.singleton noModuleName emptyScope
, scopeLocals = []
, scopePrecedence = TopCtx
}
mapScope :: (NameSpaceId -> NamesInScope -> NamesInScope ) ->
(NameSpaceId -> ModulesInScope -> ModulesInScope) ->
Scope -> Scope
mapScope fd fm = updateScopeNameSpaces $ AssocList.mapWithKey mapNS
where
mapNS acc = mapNameSpace (fd acc) (fm acc)
mapScope_ :: (NamesInScope -> NamesInScope ) ->
(ModulesInScope -> ModulesInScope) ->
Scope -> Scope
mapScope_ fd fm = mapScope (const fd) (const fm)
mapScopeM :: (Functor m, Applicative m) =>
(NameSpaceId -> NamesInScope -> m NamesInScope ) ->
(NameSpaceId -> ModulesInScope -> m ModulesInScope) ->
Scope -> m Scope
mapScopeM fd fm = updateScopeNameSpacesM $ AssocList.mapWithKeyM mapNS
where
mapNS acc = mapNameSpaceM (fd acc) (fm acc)
mapScopeM_ :: (Functor m, Applicative m) =>
(NamesInScope -> m NamesInScope ) ->
(ModulesInScope -> m ModulesInScope) ->
Scope -> m Scope
mapScopeM_ fd fm = mapScopeM (const fd) (const fm)
zipScope :: (NameSpaceId -> NamesInScope -> NamesInScope -> NamesInScope ) ->
(NameSpaceId -> ModulesInScope -> ModulesInScope -> ModulesInScope) ->
Scope -> Scope -> Scope
zipScope fd fm s1 s2 =
s1 { scopeNameSpaces = [ (nsid, zipNS nsid ns1 ns2)
| ((nsid, ns1), (nsid', ns2)) <- zipWith' (,) (scopeNameSpaces s1) (scopeNameSpaces s2)
, assert (nsid == nsid')
]
, scopeImports = Map.union (scopeImports s1) (scopeImports s2)
}
where
assert True = True
assert False = __IMPOSSIBLE__
zipNS acc = zipNameSpace (fd acc) (fm acc)
zipScope_ :: (NamesInScope -> NamesInScope -> NamesInScope ) ->
(ModulesInScope -> ModulesInScope -> ModulesInScope) ->
Scope -> Scope -> Scope
zipScope_ fd fm = zipScope (const fd) (const fm)
filterScope :: (C.Name -> Bool) -> (C.Name -> Bool) -> Scope -> Scope
filterScope pd pm = mapScope_ (Map.filterKeys pd) (Map.filterKeys pm)
allNamesInScope :: InScope a => Scope -> ThingsInScope a
allNamesInScope = namesInScope [minBound..maxBound]
allNamesInScope' :: InScope a => Scope -> ThingsInScope (a, Access)
allNamesInScope' s =
foldr1 mergeNames [ map (, nameSpaceAccess ns) <$> namesInScope [ns] s
| ns <- [minBound..maxBound] ]
exportedNamesInScope :: InScope a => Scope -> ThingsInScope a
exportedNamesInScope = namesInScope [PublicNS, ImportedNS, OnlyQualifiedNS]
namesInScope :: InScope a => [NameSpaceId] -> Scope -> ThingsInScope a
namesInScope ids s =
foldr1 mergeNames [ inNameSpace (scopeNameSpace nsid s) | nsid <- ids ]
allThingsInScope :: Scope -> NameSpace
allThingsInScope = thingsInScope [minBound..maxBound]
thingsInScope :: [NameSpaceId] -> Scope -> NameSpace
thingsInScope fs s =
NameSpace { nsNames = namesInScope fs s
, nsModules = namesInScope fs s
}
mergeScope :: Scope -> Scope -> Scope
mergeScope = zipScope_ mergeNames mergeNames
mergeScopes :: [Scope] -> Scope
mergeScopes [] = __IMPOSSIBLE__
mergeScopes ss = foldr1 mergeScope ss
setScopeAccess :: NameSpaceId -> Scope -> Scope
setScopeAccess a s = (`updateScopeNameSpaces` s) $ AssocList.mapWithKey $ const . ns
where
zero = emptyNameSpace
one = allThingsInScope s
imp = thingsInScope [ImportedNS] s
noimp = thingsInScope [PublicNS, PrivateNS, OnlyQualifiedNS] s
ns b = case (a, b) of
(PublicNS, PublicNS) -> noimp
(PublicNS, ImportedNS) -> imp
_ | a == b -> one
| otherwise -> zero
setNameSpace :: NameSpaceId -> NameSpace -> Scope -> Scope
setNameSpace nsid ns = updateScopeNameSpaces $ AssocList.update nsid ns
addNamesToScope :: NameSpaceId -> C.Name -> [AbstractName] -> Scope -> Scope
addNamesToScope acc x ys s = mergeScope s s1
where
s1 = setScopeAccess acc $ setNameSpace PublicNS ns emptyScope
ns = emptyNameSpace { nsNames = Map.singleton x ys }
addNameToScope :: NameSpaceId -> C.Name -> AbstractName -> Scope -> Scope
addNameToScope acc x y s = addNamesToScope acc x [y] s
removeNameFromScope :: NameSpaceId -> C.Name -> Scope -> Scope
removeNameFromScope ns x s = mapScope remove (const id) s
where
remove ns' | ns' /= ns = id
| otherwise = Map.delete x
addModuleToScope :: NameSpaceId -> C.Name -> AbstractModule -> Scope -> Scope
addModuleToScope acc x m s = mergeScope s s1
where
s1 = setScopeAccess acc $ setNameSpace PublicNS ns emptyScope
ns = emptyNameSpace { nsModules = Map.singleton x [m] }
applyImportDirective :: ImportDirective -> Scope -> Scope
applyImportDirective dir s = mergeScope usedOrHidden renamed
where
usedOrHidden = useOrHide (hideLHS (renaming dir) $ usingOrHiding dir) s
renamed = rename (renaming dir) $ useOrHide useRenamedThings s
useRenamedThings = Using $ map renFrom $ renaming dir
hideLHS :: [Renaming] -> UsingOrHiding -> UsingOrHiding
hideLHS _ i@(Using _) = i
hideLHS ren (Hiding xs) = Hiding $ xs ++ map renFrom ren
useOrHide :: UsingOrHiding -> Scope -> Scope
useOrHide (Hiding xs) s = filterNames notElem notElem xs s
useOrHide (Using xs) s = filterNames elem elem xs s
filterNames :: (C.Name -> [C.Name] -> Bool) -> (C.Name -> [C.Name] -> Bool) ->
[ImportedName] -> Scope -> Scope
filterNames pd pm xs = filterScope' (flip pd ds) (flip pm ms)
where
ds = [ x | ImportedName x <- xs ]
ms = [ m | ImportedModule m <- xs ]
filterScope' pd pm = filterScope pd pm
rename :: [Renaming] -> Scope -> Scope
rename rho = mapScope_ (Map.mapKeys $ ren drho)
(Map.mapKeys $ ren mrho)
where
mrho = [ (x, y) | Renaming { renFrom = ImportedModule x, renTo = y } <- rho ]
drho = [ (x, y) | Renaming { renFrom = ImportedName x, renTo = y } <- rho ]
ren r x = fromMaybe x $ lookup x r
renameCanonicalNames :: Map A.QName A.QName -> Map A.ModuleName A.ModuleName ->
Scope -> Scope
renameCanonicalNames renD renM = mapScope_ renameD renameM
where
renameD = Map.map $ map $ over lensAnameName $ \ x -> Map.findWithDefault x x renD
renameM = Map.map $ map $ over lensAmodName $ \ x -> Map.findWithDefault x x renM
restrictPrivate :: Scope -> Scope
restrictPrivate s
= setNameSpace PrivateNS emptyNameSpace
$ s { scopeImports = Map.empty }
removeOnlyQualified :: Scope -> Scope
removeOnlyQualified s = setNameSpace OnlyQualifiedNS emptyNameSpace s
inScopeBecause :: (WhyInScope -> WhyInScope) -> Scope -> Scope
inScopeBecause f = mapScope_ mapName mapMod
where
mapName = fmap . map $ \a -> a { anameLineage = f $ anameLineage a }
mapMod = fmap . map $ \a -> a { amodLineage = f $ amodLineage a }
publicModules :: ScopeInfo -> Map A.ModuleName Scope
publicModules scope = Map.filterWithKey (\ m _ -> reachable m) allMods
where
allMods = Map.map restrictPrivate $ scopeModules scope
root = scopeCurrent scope
modules s = map amodName $ concat $ Map.elems $ allNamesInScope s
chase m = m : concatMap chase ms
where ms = maybe __IMPOSSIBLE__ modules $ Map.lookup m allMods
reachable = (`elem` chase root)
everythingInScope :: ScopeInfo -> NameSpace
everythingInScope scope = allThingsInScope $ mergeScopes $
(s0 :) $ map look $ scopeParents s0
where
look m = fromMaybe __IMPOSSIBLE__ $ Map.lookup m $ scopeModules scope
s0 = look $ scopeCurrent scope
flattenScope :: [[C.Name]] -> ScopeInfo -> Map C.QName [AbstractName]
flattenScope ms scope =
Map.unionWith (++)
(build ms allNamesInScope root)
imported
where
current = moduleScope $ scopeCurrent scope
root = mergeScopes $ current : map moduleScope (scopeParents current)
imported = Map.unionsWith (++)
[ qual c (build ms' exportedNamesInScope $ moduleScope a)
| (c, a) <- Map.toList $ scopeImports root
, let
ms' = mapMaybe (maybePrefixMatch $ C.qnameParts c) ms
, not $ null ms' ]
qual c = Map.mapKeys (q c)
where
q (C.QName x) = C.Qual x
q (C.Qual m x) = C.Qual m . q x
build :: [[C.Name]] -> (forall a. InScope a => Scope -> ThingsInScope a) -> Scope -> Map C.QName [AbstractName]
build ms getNames s = Map.unionsWith (++) $
(Map.mapKeysMonotonic C.QName $ getNames s) :
[ Map.mapKeysMonotonic (\ y -> C.Qual x y) $
build ms' exportedNamesInScope $ moduleScope m
| (x, mods) <- Map.toList (getNames s)
, let ms' = [ tl | hd:tl <- ms, hd == x ]
, not $ null ms'
, AbsModule m _ <- mods ]
moduleScope :: A.ModuleName -> Scope
moduleScope m = fromMaybe __IMPOSSIBLE__ $ Map.lookup m $ scopeModules scope
scopeLookup :: InScope a => C.QName -> ScopeInfo -> [a]
scopeLookup q scope = map fst $ scopeLookup' q scope
scopeLookup' :: forall a. InScope a => C.QName -> ScopeInfo -> [(a, Access)]
scopeLookup' q scope = nubBy ((==) `on` fst) $ findName q root ++ maybeToList topImports ++ imports
where
moduleScope :: A.ModuleName -> Scope
moduleScope m = fromMaybe __IMPOSSIBLE__ $ Map.lookup m $ scopeModules scope
current :: Scope
current = moduleScope $ scopeCurrent scope
root :: Scope
root = mergeScopes $ current : map moduleScope (scopeParents current)
findName :: forall a. InScope a => C.QName -> Scope -> [(a, Access)]
findName q0 s = case q0 of
C.QName x -> lookupName x s
C.Qual x q -> do
let
mods :: [A.ModuleName]
mods = amodName . fst <$> lookupName x s
defs :: [A.ModuleName]
defs = mnameFromList . qnameToList . anameName . fst <$> lookupName x s
m <- nub $ mods ++ defs
let ss = Map.lookup m $ scopeModules scope
ss' = restrictPrivate <$> ss
s' <- maybeToList ss'
findName q s'
where
lookupName :: forall a. InScope a => C.Name -> Scope -> [(a, Access)]
lookupName x s = fromMaybe [] $ Map.lookup x $ allNamesInScope' s
topImports :: Maybe (a, Access)
topImports = case (inScopeTag :: InScopeTag a) of
NameTag -> Nothing
ModuleTag -> first (`AbsModule` Defined) <$> imported q
imported :: C.QName -> Maybe (A.ModuleName, Access)
imported q = fmap (,PublicAccess) $ Map.lookup q $ scopeImports root
imports :: [(a, Access)]
imports = do
(m, x) <- splitName q
m <- maybeToList $ fst <$> imported m
findName x $ restrictPrivate $ moduleScope m
splitName :: C.QName -> [(C.QName, C.QName)]
splitName (C.QName x) = []
splitName (C.Qual x q) =
(C.QName x, q) : [ (C.Qual x m, r) | (m, r) <- splitName q ]
data AllowAmbiguousConstructors = AllowAmbiguousConstructors | NoAmbiguousConstructors
deriving (Eq)
inverseScopeLookup :: Either A.ModuleName A.QName -> ScopeInfo -> [C.QName]
inverseScopeLookup = inverseScopeLookup' AllowAmbiguousConstructors
inverseScopeLookup' :: AllowAmbiguousConstructors -> Either A.ModuleName A.QName -> ScopeInfo -> [C.QName]
inverseScopeLookup' ambCon name scope = billToPure [ Scoping , InverseScopeLookup ] $
case name of
Left m -> best $ filter unambiguousModule $ findModule m
Right q -> best $ filter unambiguousName $ findName nameMap q
where
this = scopeCurrent scope
current = this : scopeParents (moduleScope this)
scopes = [ (m, restrict m s) | (m, s) <- Map.toList (scopeModules scope) ]
moduleScope :: A.ModuleName -> Scope
moduleScope m = fromMaybe __IMPOSSIBLE__ $ Map.lookup m $ scopeModules scope
restrict m s | m `elem` current = s
| otherwise = restrictPrivate s
len :: C.QName -> Int
len (C.QName _) = 1
len (C.Qual _ x) = 1 + len x
best :: [C.QName] -> [C.QName]
best = sortBy (compare `on` len) . filter (not . internalName)
internalName :: C.QName -> Bool
internalName C.QName{} = False
internalName (C.Qual m n) = intern m || internalName n
where
intern (C.Name _ [ C.Id ('.' : '#' : _) ]) = True
intern _ = False
unique :: forall a . [a] -> Bool
unique [] = __IMPOSSIBLE__
unique [_] = True
unique (_:_:_) = False
unambiguousModule q = unique (scopeLookup q scope :: [AbstractModule])
unambiguousName q = unique xs || AllowAmbiguousConstructors == ambCon && all ((ConName ==) . anameKind) xs
where xs = scopeLookup q scope
findName :: Ord a => Map a [(A.ModuleName, C.Name)] -> a -> [C.QName]
findName table q = do
(m, x) <- fromMaybe [] $ Map.lookup q table
if m `elem` current
then return (C.QName x)
else do
y <- findModule m
return $ C.qualify y x
findModule :: A.ModuleName -> [C.QName]
findModule q = findName moduleMap q ++
fromMaybe [] (Map.lookup q importMap)
importMap = Map.fromListWith (++) $ do
(m, s) <- scopes
(x, y) <- Map.toList $ scopeImports s
return (y, [x])
moduleMap = Map.fromListWith (++) $ do
(m, s) <- scopes
(x, ms) <- Map.toList (allNamesInScope s)
q <- amodName <$> ms
return (q, [(m, x)])
nameMap = Map.fromListWith (++) $ do
(m, s) <- scopes
(x, ms) <- Map.toList (allNamesInScope s)
q <- anameName <$> ms
return (q, [(m, x)])
inverseScopeLookupName :: A.QName -> ScopeInfo -> [C.QName]
inverseScopeLookupName x = inverseScopeLookup (Right x)
inverseScopeLookupName' :: AllowAmbiguousConstructors -> A.QName -> ScopeInfo -> [C.QName]
inverseScopeLookupName' ambCon x = inverseScopeLookup' ambCon (Right x)
inverseScopeLookupModule :: A.ModuleName -> ScopeInfo -> [C.QName]
inverseScopeLookupModule x = inverseScopeLookup (Left x)
instance Show AbstractName where
show = show . anameName
instance Show AbstractModule where
show = show . amodName
instance Show NameSpaceId where
show nsid = case nsid of
PublicNS -> "public"
PrivateNS -> "private"
ImportedNS -> "imported"
OnlyQualifiedNS -> "only-qualified"
instance Show NameSpace where
show (NameSpace names mods) =
unlines $
blockOfLines "names" (map pr $ Map.toList names) ++
blockOfLines "modules" (map pr $ Map.toList mods)
where
pr :: (Show a, Show b) => (a,b) -> String
pr (x, y) = show x ++ " --> " ++ show y
instance Show Scope where
show (scope@Scope{ scopeName = name, scopeParents = parents, scopeImports = imps }) =
unlines $
[ "scope " ++ show name ] ++ ind (
concat [ blockOfLines (show nsid) (lines $ show $ scopeNameSpace nsid scope)
| nsid <- [minBound..maxBound] ]
++ blockOfLines "imports" (case Map.keys imps of
[] -> []
ks -> [ show ks ]
)
)
where ind = map (" " ++)
blockOfLines :: String -> [String] -> [String]
blockOfLines _ [] = []
blockOfLines hd ss = hd : map (" " ++) ss
instance Show ScopeInfo where
show (ScopeInfo this mods locals ctx) =
unlines $
[ "ScopeInfo"
, " current = " ++ show this
] ++
(if null locals then [] else [ " locals = " ++ show locals ]) ++
[ " context = " ++ show ctx
, " modules"
] ++ map (" "++) (relines . map show $ Map.elems mods)
where
relines = filter (not . null) . lines . unlines
instance KillRange ScopeInfo where
killRange m = m
instance HasRange AbstractName where
getRange = getRange . anameName
instance SetRange AbstractName where
setRange r x = x { anameName = setRange r $ anameName x }