module Language.Futhark.Query
( BoundTo (..),
boundLoc,
AtPos (..),
atPos,
Pos (..),
)
where
import Control.Monad
import Control.Monad.State
import Data.List (find)
import Data.Map qualified as M
import Futhark.Util.Loc (Loc (..), Pos (..))
import Language.Futhark
import Language.Futhark.Semantic
import Language.Futhark.Traversals
import System.FilePath.Posix qualified as Posix
data BoundTo
= BoundTerm StructType Loc
| BoundModule Loc
| BoundModuleType Loc
| BoundType Loc
deriving (BoundTo -> BoundTo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoundTo -> BoundTo -> Bool
$c/= :: BoundTo -> BoundTo -> Bool
== :: BoundTo -> BoundTo -> Bool
$c== :: BoundTo -> BoundTo -> Bool
Eq, Int -> BoundTo -> ShowS
[BoundTo] -> ShowS
BoundTo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoundTo] -> ShowS
$cshowList :: [BoundTo] -> ShowS
show :: BoundTo -> String
$cshow :: BoundTo -> String
showsPrec :: Int -> BoundTo -> ShowS
$cshowsPrec :: Int -> BoundTo -> ShowS
Show)
data Def = DefBound BoundTo | DefIndirect VName
deriving (Def -> Def -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Def -> Def -> Bool
$c/= :: Def -> Def -> Bool
== :: Def -> Def -> Bool
$c== :: Def -> Def -> Bool
Eq, Int -> Def -> ShowS
[Def] -> ShowS
Def -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Def] -> ShowS
$cshowList :: [Def] -> ShowS
show :: Def -> String
$cshow :: Def -> String
showsPrec :: Int -> Def -> ShowS
$cshowsPrec :: Int -> Def -> ShowS
Show)
type Defs = M.Map VName Def
boundLoc :: BoundTo -> Loc
boundLoc :: BoundTo -> Loc
boundLoc (BoundTerm StructType
_ Loc
loc) = Loc
loc
boundLoc (BoundModule Loc
loc) = Loc
loc
boundLoc (BoundModuleType Loc
loc) = Loc
loc
boundLoc (BoundType Loc
loc) = Loc
loc
sizeDefs :: SizeBinder VName -> Defs
sizeDefs :: SizeBinder VName -> Defs
sizeDefs (SizeBinder VName
v SrcLoc
loc) =
forall k a. k -> a -> Map k a
M.singleton VName
v forall a b. (a -> b) -> a -> b
$ BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ StructType -> Loc -> BoundTo
BoundTerm (forall dim as. ScalarTypeBase dim as -> TypeBase dim as
Scalar (forall dim as. PrimType -> ScalarTypeBase dim as
Prim (IntType -> PrimType
Signed IntType
Int64))) (forall a. Located a => a -> Loc
locOf SrcLoc
loc)
patternDefs :: Pat -> Defs
patternDefs :: PatBase Info VName -> Defs
patternDefs (Id VName
vn (Info PatType
t) SrcLoc
loc) =
forall k a. k -> a -> Map k a
M.singleton VName
vn forall a b. (a -> b) -> a -> b
$ BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ StructType -> Loc -> BoundTo
BoundTerm (forall dim as. TypeBase dim as -> TypeBase dim ()
toStruct PatType
t) (forall a. Located a => a -> Loc
locOf SrcLoc
loc)
patternDefs (TuplePat [PatBase Info VName]
pats SrcLoc
_) =
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName -> Defs
patternDefs [PatBase Info VName]
pats
patternDefs (RecordPat [(Name, PatBase Info VName)]
fields SrcLoc
_) =
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (PatBase Info VName -> Defs
patternDefs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Name, PatBase Info VName)]
fields
patternDefs (PatParens PatBase Info VName
pat SrcLoc
_) = PatBase Info VName -> Defs
patternDefs PatBase Info VName
pat
patternDefs (PatAttr AttrInfo VName
_ PatBase Info VName
pat SrcLoc
_) = PatBase Info VName -> Defs
patternDefs PatBase Info VName
pat
patternDefs Wildcard {} = forall a. Monoid a => a
mempty
patternDefs PatLit {} = forall a. Monoid a => a
mempty
patternDefs (PatAscription PatBase Info VName
pat TypeExp VName
_ SrcLoc
_) =
PatBase Info VName -> Defs
patternDefs PatBase Info VName
pat
patternDefs (PatConstr Name
_ Info PatType
_ [PatBase Info VName]
pats SrcLoc
_) =
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName -> Defs
patternDefs [PatBase Info VName]
pats
typeParamDefs :: TypeParamBase VName -> Defs
typeParamDefs :: TypeParamBase VName -> Defs
typeParamDefs (TypeParamDim VName
vn SrcLoc
loc) =
forall k a. k -> a -> Map k a
M.singleton VName
vn forall a b. (a -> b) -> a -> b
$ BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ StructType -> Loc -> BoundTo
BoundTerm (forall dim as. ScalarTypeBase dim as -> TypeBase dim as
Scalar forall a b. (a -> b) -> a -> b
$ forall dim as. PrimType -> ScalarTypeBase dim as
Prim forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
Signed IntType
Int64) (forall a. Located a => a -> Loc
locOf SrcLoc
loc)
typeParamDefs (TypeParamType Liftedness
_ VName
vn SrcLoc
loc) =
forall k a. k -> a -> Map k a
M.singleton VName
vn forall a b. (a -> b) -> a -> b
$ BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundType forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
expDefs :: Exp -> Defs
expDefs :: Exp -> Defs
expDefs Exp
e =
forall s a. State s a -> s -> s
execState (forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper (StateT Defs Identity)
mapper Exp
e) Defs
extra
where
mapper :: ASTMapper (StateT Defs Identity)
mapper =
forall (m :: * -> *). Monad m => ASTMapper m
identityMapper {mapOnExp :: Exp -> StateT Defs Identity Exp
mapOnExp = forall {m :: * -> *}. MonadState Defs m => Exp -> m Exp
onExp}
onExp :: Exp -> m Exp
onExp Exp
e' = do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a. Semigroup a => a -> a -> a
<> Exp -> Defs
expDefs Exp
e')
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
e'
identDefs :: IdentBase Info k -> Map k Def
identDefs (Ident k
v (Info PatType
vt) SrcLoc
vloc) =
forall k a. k -> a -> Map k a
M.singleton k
v forall a b. (a -> b) -> a -> b
$ BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ StructType -> Loc -> BoundTo
BoundTerm (forall dim as. TypeBase dim as -> TypeBase dim ()
toStruct PatType
vt) forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
vloc
extra :: Defs
extra =
case Exp
e of
AppExp (LetPat [SizeBinder VName]
sizes PatBase Info VName
pat Exp
_ Exp
_ SrcLoc
_) Info AppRes
_ ->
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SizeBinder VName -> Defs
sizeDefs [SizeBinder VName]
sizes forall a. Semigroup a => a -> a -> a
<> PatBase Info VName -> Defs
patternDefs PatBase Info VName
pat
Lambda [PatBase Info VName]
params Exp
_ Maybe (TypeExp VName)
_ Info (Aliasing, StructRetType)
_ SrcLoc
_ ->
forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName -> Defs
patternDefs [PatBase Info VName]
params)
AppExp (LetFun VName
name ([TypeParamBase VName]
tparams, [PatBase Info VName]
params, Maybe (TypeExp VName)
_, Info StructRetType
ret, Exp
_) Exp
_ SrcLoc
loc) Info AppRes
_ ->
let name_t :: StructType
name_t = forall as dim pas.
Monoid as =>
[TypeBase dim pas] -> RetTypeBase dim as -> TypeBase dim as
foldFunType (forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName -> StructType
patternStructType [PatBase Info VName]
params) StructRetType
ret
in forall k a. k -> a -> Map k a
M.singleton VName
name (BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ StructType -> Loc -> BoundTo
BoundTerm StructType
name_t (forall a. Located a => a -> Loc
locOf SrcLoc
loc))
forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase VName -> Defs
typeParamDefs [TypeParamBase VName]
tparams)
forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName -> Defs
patternDefs [PatBase Info VName]
params)
AppExp (LetWith IdentBase Info VName
v IdentBase Info VName
_ SliceBase Info VName
_ Exp
_ Exp
_ SrcLoc
_) Info AppRes
_ ->
forall {k}. IdentBase Info k -> Map k Def
identDefs IdentBase Info VName
v
AppExp (DoLoop [VName]
_ PatBase Info VName
merge Exp
_ LoopFormBase Info VName
form Exp
_ SrcLoc
_) Info AppRes
_ ->
PatBase Info VName -> Defs
patternDefs PatBase Info VName
merge
forall a. Semigroup a => a -> a -> a
<> case LoopFormBase Info VName
form of
For IdentBase Info VName
i Exp
_ -> forall {k}. IdentBase Info k -> Map k Def
identDefs IdentBase Info VName
i
ForIn PatBase Info VName
pat Exp
_ -> PatBase Info VName -> Defs
patternDefs PatBase Info VName
pat
While {} -> forall a. Monoid a => a
mempty
Exp
_ ->
forall a. Monoid a => a
mempty
valBindDefs :: ValBind -> Defs
valBindDefs :: ValBind -> Defs
valBindDefs ValBind
vbind =
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall (f :: * -> *) vn. ValBindBase f vn -> vn
valBindName ValBind
vbind) (BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ StructType -> Loc -> BoundTo
BoundTerm StructType
vbind_t (forall a. Located a => a -> Loc
locOf ValBind
vbind)) forall a b. (a -> b) -> a -> b
$
forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase VName -> Defs
typeParamDefs (forall (f :: * -> *) vn. ValBindBase f vn -> [TypeParamBase vn]
valBindTypeParams ValBind
vbind))
forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName -> Defs
patternDefs (forall (f :: * -> *) vn. ValBindBase f vn -> [PatBase f vn]
valBindParams ValBind
vbind))
forall a. Semigroup a => a -> a -> a
<> Exp -> Defs
expDefs (forall (f :: * -> *) vn. ValBindBase f vn -> ExpBase f vn
valBindBody ValBind
vbind)
where
vbind_t :: StructType
vbind_t =
forall as dim pas.
Monoid as =>
[TypeBase dim pas] -> RetTypeBase dim as -> TypeBase dim as
foldFunType (forall a b. (a -> b) -> [a] -> [b]
map PatBase Info VName -> StructType
patternStructType (forall (f :: * -> *) vn. ValBindBase f vn -> [PatBase f vn]
valBindParams ValBind
vbind)) forall a b. (a -> b) -> a -> b
$
forall a. Info a -> a
unInfo forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) vn. ValBindBase f vn -> f StructRetType
valBindRetType ValBind
vbind
typeBindDefs :: TypeBind -> Defs
typeBindDefs :: TypeBind -> Defs
typeBindDefs TypeBind
tbind =
forall k a. k -> a -> Map k a
M.singleton (forall (f :: * -> *) vn. TypeBindBase f vn -> vn
typeAlias TypeBind
tbind) forall a b. (a -> b) -> a -> b
$ BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundType forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf TypeBind
tbind
modParamDefs :: ModParam -> Defs
modParamDefs :: ModParam -> Defs
modParamDefs (ModParam VName
p SigExpBase Info VName
se Info [VName]
_ SrcLoc
loc) =
forall k a. k -> a -> Map k a
M.singleton VName
p (BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundModule forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc)
forall a. Semigroup a => a -> a -> a
<> SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
se
modExpDefs :: ModExp -> Defs
modExpDefs :: ModExp -> Defs
modExpDefs ModVar {} =
forall a. Monoid a => a
mempty
modExpDefs (ModParens ModExp
me SrcLoc
_) =
ModExp -> Defs
modExpDefs ModExp
me
modExpDefs ModImport {} =
forall a. Monoid a => a
mempty
modExpDefs (ModDecs [Dec]
decs SrcLoc
_) =
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Dec -> Defs
decDefs [Dec]
decs
modExpDefs (ModApply ModExp
e1 ModExp
e2 Info (Map VName VName)
_ (Info Map VName VName
substs) SrcLoc
_) =
ModExp -> Defs
modExpDefs ModExp
e1 forall a. Semigroup a => a -> a -> a
<> ModExp -> Defs
modExpDefs ModExp
e2 forall a. Semigroup a => a -> a -> a
<> forall a b k. (a -> b) -> Map k a -> Map k b
M.map VName -> Def
DefIndirect Map VName VName
substs
modExpDefs (ModAscript ModExp
e SigExpBase Info VName
_ (Info Map VName VName
substs) SrcLoc
_) =
ModExp -> Defs
modExpDefs ModExp
e forall a. Semigroup a => a -> a -> a
<> forall a b k. (a -> b) -> Map k a -> Map k b
M.map VName -> Def
DefIndirect Map VName VName
substs
modExpDefs (ModLambda ModParam
p Maybe (SigExpBase Info VName, Info (Map VName VName))
_ ModExp
e SrcLoc
_) =
ModParam -> Defs
modParamDefs ModParam
p forall a. Semigroup a => a -> a -> a
<> ModExp -> Defs
modExpDefs ModExp
e
modBindDefs :: ModBind -> Defs
modBindDefs :: ModBind -> Defs
modBindDefs ModBind
mbind =
forall k a. k -> a -> Map k a
M.singleton (forall (f :: * -> *) vn. ModBindBase f vn -> vn
modName ModBind
mbind) (BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundModule forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf ModBind
mbind)
forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map ModParam -> Defs
modParamDefs (forall (f :: * -> *) vn. ModBindBase f vn -> [ModParamBase f vn]
modParams ModBind
mbind))
forall a. Semigroup a => a -> a -> a
<> ModExp -> Defs
modExpDefs (forall (f :: * -> *) vn. ModBindBase f vn -> ModExpBase f vn
modExp ModBind
mbind)
forall a. Semigroup a => a -> a -> a
<> case forall (f :: * -> *) vn.
ModBindBase f vn -> Maybe (SigExpBase f vn, f (Map VName VName))
modSignature ModBind
mbind of
Maybe (SigExpBase Info VName, Info (Map VName VName))
Nothing -> forall a. Monoid a => a
mempty
Just (SigExpBase Info VName
_, Info Map VName VName
substs) ->
forall a b k. (a -> b) -> Map k a -> Map k b
M.map VName -> Def
DefIndirect Map VName VName
substs
specDefs :: Spec -> Defs
specDefs :: Spec -> Defs
specDefs Spec
spec =
case Spec
spec of
ValSpec VName
v [TypeParamBase VName]
tparams TypeExp VName
_ (Info StructType
t) Maybe DocComment
_ SrcLoc
loc ->
let vdef :: Def
vdef = BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ StructType -> Loc -> BoundTo
BoundTerm StructType
t (forall a. Located a => a -> Loc
locOf SrcLoc
loc)
in forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VName
v Def
vdef forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase VName -> Defs
typeParamDefs [TypeParamBase VName]
tparams)
TypeAbbrSpec TypeBind
tbind -> TypeBind -> Defs
typeBindDefs TypeBind
tbind
TypeSpec Liftedness
_ VName
v [TypeParamBase VName]
_ Maybe DocComment
_ SrcLoc
loc ->
forall k a. k -> a -> Map k a
M.singleton VName
v forall a b. (a -> b) -> a -> b
$ BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundType forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
ModSpec VName
v SigExpBase Info VName
se Maybe DocComment
_ SrcLoc
loc ->
forall k a. k -> a -> Map k a
M.singleton VName
v (BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundModuleType forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc)
forall a. Semigroup a => a -> a -> a
<> SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
se
IncludeSpec SigExpBase Info VName
se SrcLoc
_ -> SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
se
sigExpDefs :: SigExp -> Defs
sigExpDefs :: SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
se =
case SigExpBase Info VName
se of
SigVar QualName VName
_ (Info Map VName VName
substs) SrcLoc
_ -> forall a b k. (a -> b) -> Map k a -> Map k b
M.map VName -> Def
DefIndirect Map VName VName
substs
SigParens SigExpBase Info VName
e SrcLoc
_ -> SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
e
SigSpecs [Spec]
specs SrcLoc
_ -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Spec -> Defs
specDefs [Spec]
specs
SigWith SigExpBase Info VName
e TypeRefBase VName
_ SrcLoc
_ -> SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
e
SigArrow Maybe VName
_ SigExpBase Info VName
e1 SigExpBase Info VName
e2 SrcLoc
_ -> SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
e1 forall a. Semigroup a => a -> a -> a
<> SigExpBase Info VName -> Defs
sigExpDefs SigExpBase Info VName
e2
sigBindDefs :: SigBind -> Defs
sigBindDefs :: SigBind -> Defs
sigBindDefs SigBind
sbind =
forall k a. k -> a -> Map k a
M.singleton (forall (f :: * -> *) vn. SigBindBase f vn -> vn
sigName SigBind
sbind) (BoundTo -> Def
DefBound forall a b. (a -> b) -> a -> b
$ Loc -> BoundTo
BoundModuleType forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SigBind
sbind)
forall a. Semigroup a => a -> a -> a
<> SigExpBase Info VName -> Defs
sigExpDefs (forall (f :: * -> *) vn. SigBindBase f vn -> SigExpBase f vn
sigExp SigBind
sbind)
decDefs :: Dec -> Defs
decDefs :: Dec -> Defs
decDefs (ValDec ValBind
vbind) = ValBind -> Defs
valBindDefs ValBind
vbind
decDefs (TypeDec TypeBind
vbind) = TypeBind -> Defs
typeBindDefs TypeBind
vbind
decDefs (ModDec ModBind
mbind) = ModBind -> Defs
modBindDefs ModBind
mbind
decDefs (SigDec SigBind
mbind) = SigBind -> Defs
sigBindDefs SigBind
mbind
decDefs (OpenDec ModExp
me SrcLoc
_) = ModExp -> Defs
modExpDefs ModExp
me
decDefs (LocalDec Dec
dec SrcLoc
_) = Dec -> Defs
decDefs Dec
dec
decDefs ImportDec {} = forall a. Monoid a => a
mempty
progDefs :: Prog -> Defs
progDefs :: Prog -> Defs
progDefs = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Dec -> Defs
decDefs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
progDecs
allBindings :: Imports -> M.Map VName BoundTo
allBindings :: Imports -> Map VName BoundTo
allBindings Imports
imports = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe Def -> Maybe BoundTo
forward Defs
defs
where
defs :: Defs
defs = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Prog -> Defs
progDefs forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileModule -> Prog
fileProg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Imports
imports
forward :: Def -> Maybe BoundTo
forward (DefBound BoundTo
x) = forall a. a -> Maybe a
Just BoundTo
x
forward (DefIndirect VName
v) = Def -> Maybe BoundTo
forward forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
v Defs
defs
data RawAtPos = RawAtName (QualName VName) Loc
contains :: Located a => a -> Pos -> Bool
contains :: forall a. Located a => a -> Pos -> Bool
contains a
a Pos
pos =
case forall a. Located a => a -> Loc
locOf a
a of
Loc Pos
start Pos
end -> Pos
pos forall a. Ord a => a -> a -> Bool
>= Pos
start Bool -> Bool -> Bool
&& Pos
pos forall a. Ord a => a -> a -> Bool
<= Pos
end
Loc
NoLoc -> Bool
False
atPosInTypeExp :: TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp :: TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
te Pos
pos =
case TypeExp VName
te of
TEVar QualName VName
qn SrcLoc
loc -> do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ SrcLoc
loc forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName QualName VName
qn forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
TETuple [TypeExp VName]
es SrcLoc
_ ->
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (TypeExp VName -> Pos -> Maybe RawAtPos
`atPosInTypeExp` Pos
pos) [TypeExp VName]
es
TERecord [(Name, TypeExp VName)]
fields SrcLoc
_ ->
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((TypeExp VName -> Pos -> Maybe RawAtPos
`atPosInTypeExp` Pos
pos) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Name, TypeExp VName)]
fields
TEArray SizeExp VName
dim TypeExp VName
te' SrcLoc
_ ->
TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
te' Pos
pos forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` SizeExp VName -> Maybe RawAtPos
inDim SizeExp VName
dim
TEUnique TypeExp VName
te' SrcLoc
_ ->
TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
te' Pos
pos
TEApply TypeExp VName
e1 TypeArgExp VName
arg SrcLoc
_ ->
TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
e1 Pos
pos forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` TypeArgExp VName -> Maybe RawAtPos
inArg TypeArgExp VName
arg
TEArrow Maybe VName
_ TypeExp VName
e1 TypeExp VName
e2 SrcLoc
_ ->
TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
e1 Pos
pos forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
e2 Pos
pos
TESum [(Name, [TypeExp VName])]
cs SrcLoc
_ ->
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (TypeExp VName -> Pos -> Maybe RawAtPos
`atPosInTypeExp` Pos
pos) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(Name, [TypeExp VName])]
cs
TEDim [VName]
_ TypeExp VName
t SrcLoc
_ ->
TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
t Pos
pos
where
inArg :: TypeArgExp VName -> Maybe RawAtPos
inArg (TypeArgExpDim SizeExp VName
dim SrcLoc
_) = SizeExp VName -> Maybe RawAtPos
inDim SizeExp VName
dim
inArg (TypeArgExpType TypeExp VName
e2) = TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
e2 Pos
pos
inDim :: SizeExp VName -> Maybe RawAtPos
inDim (SizeExpNamed QualName VName
qn SrcLoc
loc) = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ SrcLoc
loc forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName QualName VName
qn forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
inDim SizeExp VName
_ = forall a. Maybe a
Nothing
atPosInPat :: Pat -> Pos -> Maybe RawAtPos
atPosInPat :: PatBase Info VName -> Pos -> Maybe RawAtPos
atPosInPat (Id VName
vn Info PatType
_ SrcLoc
loc) Pos
pos = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ SrcLoc
loc forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName (forall v. v -> QualName v
qualName VName
vn) forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
atPosInPat (TuplePat [PatBase Info VName]
pats SrcLoc
_) Pos
pos =
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (PatBase Info VName -> Pos -> Maybe RawAtPos
`atPosInPat` Pos
pos) [PatBase Info VName]
pats
atPosInPat (RecordPat [(Name, PatBase Info VName)]
fields SrcLoc
_) Pos
pos =
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((PatBase Info VName -> Pos -> Maybe RawAtPos
`atPosInPat` Pos
pos) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Name, PatBase Info VName)]
fields
atPosInPat (PatParens PatBase Info VName
pat SrcLoc
_) Pos
pos =
PatBase Info VName -> Pos -> Maybe RawAtPos
atPosInPat PatBase Info VName
pat Pos
pos
atPosInPat (PatAttr AttrInfo VName
_ PatBase Info VName
pat SrcLoc
_) Pos
pos =
PatBase Info VName -> Pos -> Maybe RawAtPos
atPosInPat PatBase Info VName
pat Pos
pos
atPosInPat (PatAscription PatBase Info VName
pat TypeExp VName
te SrcLoc
_) Pos
pos =
PatBase Info VName -> Pos -> Maybe RawAtPos
atPosInPat PatBase Info VName
pat Pos
pos forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
te Pos
pos
atPosInPat (PatConstr Name
_ Info PatType
_ [PatBase Info VName]
pats SrcLoc
_) Pos
pos =
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (PatBase Info VName -> Pos -> Maybe RawAtPos
`atPosInPat` Pos
pos) [PatBase Info VName]
pats
atPosInPat PatLit {} Pos
_ = forall a. Maybe a
Nothing
atPosInPat Wildcard {} Pos
_ = forall a. Maybe a
Nothing
atPosInExp :: Exp -> Pos -> Maybe RawAtPos
atPosInExp :: Exp -> Pos -> Maybe RawAtPos
atPosInExp (Var QualName VName
qn Info PatType
_ SrcLoc
loc) Pos
pos = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ SrcLoc
loc forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName QualName VName
qn forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
atPosInExp (QualParens (QualName VName
qn, SrcLoc
loc) Exp
_ SrcLoc
_) Pos
pos
| SrcLoc
loc forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName QualName VName
qn forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
atPosInExp Literal {} Pos
_ = forall a. Maybe a
Nothing
atPosInExp IntLit {} Pos
_ = forall a. Maybe a
Nothing
atPosInExp FloatLit {} Pos
_ = forall a. Maybe a
Nothing
atPosInExp (AppExp (LetPat [SizeBinder VName]
_ PatBase Info VName
pat Exp
_ Exp
_ SrcLoc
_) Info AppRes
_) Pos
pos
| PatBase Info VName
pat forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = PatBase Info VName -> Pos -> Maybe RawAtPos
atPosInPat PatBase Info VName
pat Pos
pos
atPosInExp (AppExp (LetWith IdentBase Info VName
a IdentBase Info VName
b SliceBase Info VName
_ Exp
_ Exp
_ SrcLoc
_) Info AppRes
_) Pos
pos
| IdentBase Info VName
a forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName (forall v. v -> QualName v
qualName forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. IdentBase f vn -> vn
identName IdentBase Info VName
a) (forall a. Located a => a -> Loc
locOf IdentBase Info VName
a)
| IdentBase Info VName
b forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName (forall v. v -> QualName v
qualName forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. IdentBase f vn -> vn
identName IdentBase Info VName
b) (forall a. Located a => a -> Loc
locOf IdentBase Info VName
b)
atPosInExp (AppExp (DoLoop [VName]
_ PatBase Info VName
merge Exp
_ LoopFormBase Info VName
_ Exp
_ SrcLoc
_) Info AppRes
_) Pos
pos
| PatBase Info VName
merge forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = PatBase Info VName -> Pos -> Maybe RawAtPos
atPosInPat PatBase Info VName
merge Pos
pos
atPosInExp (Ascript Exp
_ TypeExp VName
te SrcLoc
_) Pos
pos
| TypeExp VName
te forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
te Pos
pos
atPosInExp (AppExp (Coerce Exp
_ TypeExp VName
te SrcLoc
_) Info AppRes
_) Pos
pos
| TypeExp VName
te forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos = TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
te Pos
pos
atPosInExp Exp
e Pos
pos = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Exp
e forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
case forall x (m :: * -> *).
(ASTMappable x, Monad m) =>
ASTMapper m -> x -> m x
astMap ASTMapper (Either RawAtPos)
mapper Exp
e of
Left RawAtPos
atpos -> forall a. a -> Maybe a
Just RawAtPos
atpos
Right Exp
_ -> forall a. Maybe a
Nothing
where
mapper :: ASTMapper (Either RawAtPos)
mapper =
forall (m :: * -> *). Monad m => ASTMapper m
identityMapper {mapOnExp :: Exp -> Either RawAtPos Exp
mapOnExp = Exp -> Either RawAtPos Exp
onExp}
onExp :: Exp -> Either RawAtPos Exp
onExp Exp
e' =
case Exp -> Pos -> Maybe RawAtPos
atPosInExp Exp
e' Pos
pos of
Just RawAtPos
atpos -> forall a b. a -> Either a b
Left RawAtPos
atpos
Maybe RawAtPos
Nothing -> forall a b. b -> Either a b
Right Exp
e'
atPosInModExp :: ModExp -> Pos -> Maybe RawAtPos
atPosInModExp :: ModExp -> Pos -> Maybe RawAtPos
atPosInModExp (ModVar QualName VName
qn SrcLoc
loc) Pos
pos = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ SrcLoc
loc forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName QualName VName
qn forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
atPosInModExp (ModParens ModExp
me SrcLoc
_) Pos
pos =
ModExp -> Pos -> Maybe RawAtPos
atPosInModExp ModExp
me Pos
pos
atPosInModExp ModImport {} Pos
_ =
forall a. Maybe a
Nothing
atPosInModExp (ModDecs [Dec]
decs SrcLoc
_) Pos
pos =
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Dec -> Pos -> Maybe RawAtPos
`atPosInDec` Pos
pos) [Dec]
decs
atPosInModExp (ModApply ModExp
e1 ModExp
e2 Info (Map VName VName)
_ Info (Map VName VName)
_ SrcLoc
_) Pos
pos =
ModExp -> Pos -> Maybe RawAtPos
atPosInModExp ModExp
e1 Pos
pos forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ModExp -> Pos -> Maybe RawAtPos
atPosInModExp ModExp
e2 Pos
pos
atPosInModExp (ModAscript ModExp
e SigExpBase Info VName
_ Info (Map VName VName)
_ SrcLoc
_) Pos
pos =
ModExp -> Pos -> Maybe RawAtPos
atPosInModExp ModExp
e Pos
pos
atPosInModExp (ModLambda ModParam
_ Maybe (SigExpBase Info VName, Info (Map VName VName))
_ ModExp
e SrcLoc
_) Pos
pos =
ModExp -> Pos -> Maybe RawAtPos
atPosInModExp ModExp
e Pos
pos
atPosInSpec :: Spec -> Pos -> Maybe RawAtPos
atPosInSpec :: Spec -> Pos -> Maybe RawAtPos
atPosInSpec Spec
spec Pos
pos =
case Spec
spec of
ValSpec VName
_ [TypeParamBase VName]
_ TypeExp VName
te Info StructType
_ Maybe DocComment
_ SrcLoc
_ -> TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp TypeExp VName
te Pos
pos
TypeAbbrSpec TypeBind
tbind -> TypeBind -> Pos -> Maybe RawAtPos
atPosInTypeBind TypeBind
tbind Pos
pos
TypeSpec {} -> forall a. Maybe a
Nothing
ModSpec VName
_ SigExpBase Info VName
se Maybe DocComment
_ SrcLoc
_ -> SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
se Pos
pos
IncludeSpec SigExpBase Info VName
se SrcLoc
_ -> SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
se Pos
pos
atPosInSigExp :: SigExp -> Pos -> Maybe RawAtPos
atPosInSigExp :: SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
se Pos
pos =
case SigExpBase Info VName
se of
SigVar QualName VName
qn Info (Map VName VName)
_ SrcLoc
loc -> do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ SrcLoc
loc forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Loc -> RawAtPos
RawAtName QualName VName
qn forall a b. (a -> b) -> a -> b
$ forall a. Located a => a -> Loc
locOf SrcLoc
loc
SigParens SigExpBase Info VName
e SrcLoc
_ -> SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
e Pos
pos
SigSpecs [Spec]
specs SrcLoc
_ -> forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Spec -> Pos -> Maybe RawAtPos
`atPosInSpec` Pos
pos) [Spec]
specs
SigWith SigExpBase Info VName
e TypeRefBase VName
_ SrcLoc
_ -> SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
e Pos
pos
SigArrow Maybe VName
_ SigExpBase Info VName
e1 SigExpBase Info VName
e2 SrcLoc
_ -> SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
e1 Pos
pos forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
e2 Pos
pos
atPosInValBind :: ValBind -> Pos -> Maybe RawAtPos
atPosInValBind :: ValBind -> Pos -> Maybe RawAtPos
atPosInValBind ValBind
vbind Pos
pos =
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (forall a b. (a -> b) -> [a] -> [b]
map (PatBase Info VName -> Pos -> Maybe RawAtPos
`atPosInPat` Pos
pos) (forall (f :: * -> *) vn. ValBindBase f vn -> [PatBase f vn]
valBindParams ValBind
vbind))
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Exp -> Pos -> Maybe RawAtPos
atPosInExp (forall (f :: * -> *) vn. ValBindBase f vn -> ExpBase f vn
valBindBody ValBind
vbind) Pos
pos
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) vn. ValBindBase f vn -> Maybe (TypeExp vn)
valBindRetDecl ValBind
vbind forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Pos
pos)
atPosInTypeBind :: TypeBind -> Pos -> Maybe RawAtPos
atPosInTypeBind :: TypeBind -> Pos -> Maybe RawAtPos
atPosInTypeBind = TypeExp VName -> Pos -> Maybe RawAtPos
atPosInTypeExp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) vn. TypeBindBase f vn -> TypeExp vn
typeExp
atPosInModBind :: ModBind -> Pos -> Maybe RawAtPos
atPosInModBind :: ModBind -> Pos -> Maybe RawAtPos
atPosInModBind (ModBind VName
_ [ModParam]
params Maybe (SigExpBase Info VName, Info (Map VName VName))
sig ModExp
e Maybe DocComment
_ SrcLoc
_) Pos
pos =
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (forall a b. (a -> b) -> [a] -> [b]
map ModParam -> Maybe RawAtPos
inParam [ModParam]
params)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ModExp -> Pos -> Maybe RawAtPos
atPosInModExp ModExp
e Pos
pos
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` case Maybe (SigExpBase Info VName, Info (Map VName VName))
sig of
Maybe (SigExpBase Info VName, Info (Map VName VName))
Nothing -> forall a. Maybe a
Nothing
Just (SigExpBase Info VName
se, Info (Map VName VName)
_) -> SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
se Pos
pos
where
inParam :: ModParam -> Maybe RawAtPos
inParam (ModParam VName
_ SigExpBase Info VName
se Info [VName]
_ SrcLoc
_) = SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp SigExpBase Info VName
se Pos
pos
atPosInSigBind :: SigBind -> Pos -> Maybe RawAtPos
atPosInSigBind :: SigBind -> Pos -> Maybe RawAtPos
atPosInSigBind = SigExpBase Info VName -> Pos -> Maybe RawAtPos
atPosInSigExp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) vn. SigBindBase f vn -> SigExpBase f vn
sigExp
atPosInDec :: Dec -> Pos -> Maybe RawAtPos
atPosInDec :: Dec -> Pos -> Maybe RawAtPos
atPosInDec Dec
dec Pos
pos = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Dec
dec forall a. Located a => a -> Pos -> Bool
`contains` Pos
pos
case Dec
dec of
ValDec ValBind
vbind -> ValBind -> Pos -> Maybe RawAtPos
atPosInValBind ValBind
vbind Pos
pos
TypeDec TypeBind
tbind -> TypeBind -> Pos -> Maybe RawAtPos
atPosInTypeBind TypeBind
tbind Pos
pos
ModDec ModBind
mbind -> ModBind -> Pos -> Maybe RawAtPos
atPosInModBind ModBind
mbind Pos
pos
SigDec SigBind
sbind -> SigBind -> Pos -> Maybe RawAtPos
atPosInSigBind SigBind
sbind Pos
pos
OpenDec ModExp
e SrcLoc
_ -> ModExp -> Pos -> Maybe RawAtPos
atPosInModExp ModExp
e Pos
pos
LocalDec Dec
dec' SrcLoc
_ -> Dec -> Pos -> Maybe RawAtPos
atPosInDec Dec
dec' Pos
pos
ImportDec {} -> forall a. Maybe a
Nothing
atPosInProg :: Prog -> Pos -> Maybe RawAtPos
atPosInProg :: Prog -> Pos -> Maybe RawAtPos
atPosInProg Prog
prog Pos
pos =
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Dec -> Pos -> Maybe RawAtPos
`atPosInDec` Pos
pos) (forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
progDecs Prog
prog)
containingModule :: Imports -> Pos -> Maybe FileModule
containingModule :: Imports -> Pos -> Maybe FileModule
containingModule Imports
imports (Pos String
file Int
_ Int
_ Int
_) =
forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== String
file') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Imports
imports
where
file' :: String
file' = ImportName -> String
includeToString forall a b. (a -> b) -> a -> b
$ String -> ImportName
mkInitialImport forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ String -> (String, String)
Posix.splitExtension String
file
data AtPos = AtName (QualName VName) (Maybe BoundTo) Loc
deriving (AtPos -> AtPos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AtPos -> AtPos -> Bool
$c/= :: AtPos -> AtPos -> Bool
== :: AtPos -> AtPos -> Bool
$c== :: AtPos -> AtPos -> Bool
Eq, Int -> AtPos -> ShowS
[AtPos] -> ShowS
AtPos -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AtPos] -> ShowS
$cshowList :: [AtPos] -> ShowS
show :: AtPos -> String
$cshow :: AtPos -> String
showsPrec :: Int -> AtPos -> ShowS
$cshowsPrec :: Int -> AtPos -> ShowS
Show)
atPos :: Imports -> Pos -> Maybe AtPos
atPos :: Imports -> Pos -> Maybe AtPos
atPos Imports
imports Pos
pos = do
Prog
prog <- FileModule -> Prog
fileProg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Imports -> Pos -> Maybe FileModule
containingModule Imports
imports Pos
pos
RawAtName QualName VName
qn Loc
loc <- Prog -> Pos -> Maybe RawAtPos
atPosInProg Prog
prog Pos
pos
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ QualName VName -> Maybe BoundTo -> Loc -> AtPos
AtName QualName VName
qn (forall vn. QualName vn -> vn
qualLeaf QualName VName
qn forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Imports -> Map VName BoundTo
allBindings Imports
imports) Loc
loc