{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveFunctor #-}
module GHC.Iface.Ext.Utils where
import GHC.Prelude
import GHC.Core.Map.Type
import GHC.Driver.Session ( DynFlags )
import GHC.Driver.Ppr
import GHC.Data.FastString ( FastString, mkFastString )
import GHC.Iface.Type
import GHC.Types.Name hiding (varName)
import GHC.Types.Name.Set
import GHC.Utils.Outputable hiding ( (<>) )
import qualified GHC.Utils.Outputable as O
import GHC.Types.SrcLoc
import GHC.CoreToIface
import GHC.Core.TyCon
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.Compare( nonDetCmpType )
import GHC.Core.Type
import GHC.Types.Var
import GHC.Types.Var.Env
import GHC.Parser.Annotation
import qualified GHC.Data.Strict as Strict
import GHC.Iface.Ext.Types
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.IntMap.Strict as IM
import qualified Data.Array as A
import Data.Data ( typeOf, typeRepTyCon, Data(toConstr) )
import Data.Maybe ( maybeToList, mapMaybe)
import Data.Monoid
import Data.List (find)
import Data.Traversable ( for )
import Data.Coerce
import GHC.Utils.Monad.State.Strict hiding (get)
import GHC.Utils.Panic.Plain( assert )
import Control.Monad.Trans.Reader
import qualified Data.Tree as Tree
type RefMap a = M.Map Identifier [(Span, IdentifierDetails a)]
generateReferencesMap
:: Foldable f
=> f (HieAST a)
-> RefMap a
generateReferencesMap :: forall (f :: * -> *) a. Foldable f => f (HieAST a) -> RefMap a
generateReferencesMap = (HieAST a -> RefMap a -> RefMap a)
-> RefMap a -> f (HieAST a) -> RefMap a
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\HieAST a
ast RefMap a
m -> ([(Span, IdentifierDetails a)]
-> [(Span, IdentifierDetails a)] -> [(Span, IdentifierDetails a)])
-> RefMap a -> RefMap a -> RefMap a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith [(Span, IdentifierDetails a)]
-> [(Span, IdentifierDetails a)] -> [(Span, IdentifierDetails a)]
forall a. [a] -> [a] -> [a]
(++) (HieAST a -> RefMap a
forall {a}.
HieAST a -> Map Identifier [(Span, IdentifierDetails a)]
go HieAST a
ast) RefMap a
m) RefMap a
forall k a. Map k a
M.empty
where
go :: HieAST a -> Map Identifier [(Span, IdentifierDetails a)]
go HieAST a
ast = ([(Span, IdentifierDetails a)]
-> [(Span, IdentifierDetails a)] -> [(Span, IdentifierDetails a)])
-> [Map Identifier [(Span, IdentifierDetails a)]]
-> Map Identifier [(Span, IdentifierDetails a)]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith [(Span, IdentifierDetails a)]
-> [(Span, IdentifierDetails a)] -> [(Span, IdentifierDetails a)]
forall a. [a] -> [a] -> [a]
(++) (Map Identifier [(Span, IdentifierDetails a)]
this Map Identifier [(Span, IdentifierDetails a)]
-> [Map Identifier [(Span, IdentifierDetails a)]]
-> [Map Identifier [(Span, IdentifierDetails a)]]
forall a. a -> [a] -> [a]
: (HieAST a -> Map Identifier [(Span, IdentifierDetails a)])
-> [HieAST a] -> [Map Identifier [(Span, IdentifierDetails a)]]
forall a b. (a -> b) -> [a] -> [b]
map HieAST a -> Map Identifier [(Span, IdentifierDetails a)]
go (HieAST a -> [HieAST a]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST a
ast))
where
this :: Map Identifier [(Span, IdentifierDetails a)]
this = (IdentifierDetails a -> [(Span, IdentifierDetails a)])
-> Map Identifier (IdentifierDetails a)
-> Map Identifier [(Span, IdentifierDetails a)]
forall a b. (a -> b) -> Map Identifier a -> Map Identifier b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Span, IdentifierDetails a) -> [(Span, IdentifierDetails a)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Span, IdentifierDetails a) -> [(Span, IdentifierDetails a)])
-> (IdentifierDetails a -> (Span, IdentifierDetails a))
-> IdentifierDetails a
-> [(Span, IdentifierDetails a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HieAST a -> Span
forall a. HieAST a -> Span
nodeSpan HieAST a
ast,)) (Map Identifier (IdentifierDetails a)
-> Map Identifier [(Span, IdentifierDetails a)])
-> Map Identifier (IdentifierDetails a)
-> Map Identifier [(Span, IdentifierDetails a)]
forall a b. (a -> b) -> a -> b
$ SourcedNodeInfo a -> Map Identifier (IdentifierDetails a)
forall a. SourcedNodeInfo a -> NodeIdentifiers a
sourcedNodeIdents (SourcedNodeInfo a -> Map Identifier (IdentifierDetails a))
-> SourcedNodeInfo a -> Map Identifier (IdentifierDetails a)
forall a b. (a -> b) -> a -> b
$ HieAST a -> SourcedNodeInfo a
forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo HieAST a
ast
renderHieType :: DynFlags -> HieTypeFix -> String
renderHieType :: DynFlags -> HieTypeFix -> String
renderHieType DynFlags
dflags HieTypeFix
ht = DynFlags -> SDoc -> String
showSDoc DynFlags
dflags (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (IfaceType -> SDoc) -> IfaceType -> SDoc
forall a b. (a -> b) -> a -> b
$ HieTypeFix -> IfaceType
hieTypeToIface HieTypeFix
ht)
resolveVisibility :: Type -> [Type] -> [(Bool,Type)]
resolveVisibility :: Type -> [Type] -> [(Bool, Type)]
resolveVisibility Type
kind [Type]
ty_args
= Subst -> Type -> [Type] -> [(Bool, Type)]
go (InScopeSet -> Subst
mkEmptySubst InScopeSet
in_scope) Type
kind [Type]
ty_args
where
in_scope :: InScopeSet
in_scope = VarSet -> InScopeSet
mkInScopeSet ([Type] -> VarSet
tyCoVarsOfTypes [Type]
ty_args)
go :: Subst -> Type -> [Type] -> [(Bool, Type)]
go Subst
_ Type
_ [] = []
go Subst
env Type
ty [Type]
ts
| Just Type
ty' <- Type -> Maybe Type
coreView Type
ty
= Subst -> Type -> [Type] -> [(Bool, Type)]
go Subst
env Type
ty' [Type]
ts
go Subst
env (ForAllTy (Bndr TyCoVar
tv ForAllTyFlag
vis) Type
res) (Type
t:[Type]
ts)
| ForAllTyFlag -> Bool
isVisibleForAllTyFlag ForAllTyFlag
vis = (Bool
True , Type
t) (Bool, Type) -> [(Bool, Type)] -> [(Bool, Type)]
forall a. a -> [a] -> [a]
: [(Bool, Type)]
ts'
| Bool
otherwise = (Bool
False, Type
t) (Bool, Type) -> [(Bool, Type)] -> [(Bool, Type)]
forall a. a -> [a] -> [a]
: [(Bool, Type)]
ts'
where
ts' :: [(Bool, Type)]
ts' = Subst -> Type -> [Type] -> [(Bool, Type)]
go (Subst -> TyCoVar -> Type -> Subst
extendTvSubst Subst
env TyCoVar
tv Type
t) Type
res [Type]
ts
go Subst
env (FunTy { ft_res :: Type -> Type
ft_res = Type
res }) (Type
t:[Type]
ts)
= (Bool
True,Type
t) (Bool, Type) -> [(Bool, Type)] -> [(Bool, Type)]
forall a. a -> [a] -> [a]
: (Subst -> Type -> [Type] -> [(Bool, Type)]
go Subst
env Type
res [Type]
ts)
go Subst
env (TyVarTy TyCoVar
tv) [Type]
ts
| Just Type
ki <- Subst -> TyCoVar -> Maybe Type
lookupTyVar Subst
env TyCoVar
tv = Subst -> Type -> [Type] -> [(Bool, Type)]
go Subst
env Type
ki [Type]
ts
go Subst
env Type
kind (Type
t:[Type]
ts) = (Bool
True, Type
t) (Bool, Type) -> [(Bool, Type)] -> [(Bool, Type)]
forall a. a -> [a] -> [a]
: (Subst -> Type -> [Type] -> [(Bool, Type)]
go Subst
env Type
kind [Type]
ts)
foldType :: (HieType a -> a) -> HieTypeFix -> a
foldType :: forall a. (HieType a -> a) -> HieTypeFix -> a
foldType HieType a -> a
f (Roll HieType HieTypeFix
t) = HieType a -> a
f (HieType a -> a) -> HieType a -> a
forall a b. (a -> b) -> a -> b
$ (HieTypeFix -> a) -> HieType HieTypeFix -> HieType a
forall a b. (a -> b) -> HieType a -> HieType b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HieType a -> a) -> HieTypeFix -> a
forall a. (HieType a -> a) -> HieTypeFix -> a
foldType HieType a -> a
f) HieType HieTypeFix
t
selectPoint :: HieFile -> (Int,Int) -> Maybe (HieAST Int)
selectPoint :: HieFile -> (Int, Int) -> Maybe (HieAST Int)
selectPoint HieFile
hf (Int
sl,Int
sc) = First (HieAST Int) -> Maybe (HieAST Int)
forall a. First a -> Maybe a
getFirst (First (HieAST Int) -> Maybe (HieAST Int))
-> First (HieAST Int) -> Maybe (HieAST Int)
forall a b. (a -> b) -> a -> b
$
(((HiePath, HieAST Int) -> First (HieAST Int))
-> [(HiePath, HieAST Int)] -> First (HieAST Int))
-> [(HiePath, HieAST Int)]
-> ((HiePath, HieAST Int) -> First (HieAST Int))
-> First (HieAST Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((HiePath, HieAST Int) -> First (HieAST Int))
-> [(HiePath, HieAST Int)] -> First (HieAST Int)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Map HiePath (HieAST Int) -> [(HiePath, HieAST Int)]
forall k a. Map k a -> [(k, a)]
M.toList (HieASTs Int -> Map HiePath (HieAST Int)
forall a. HieASTs a -> Map HiePath (HieAST a)
getAsts (HieASTs Int -> Map HiePath (HieAST Int))
-> HieASTs Int -> Map HiePath (HieAST Int)
forall a b. (a -> b) -> a -> b
$ HieFile -> HieASTs Int
hie_asts HieFile
hf)) (((HiePath, HieAST Int) -> First (HieAST Int))
-> First (HieAST Int))
-> ((HiePath, HieAST Int) -> First (HieAST Int))
-> First (HieAST Int)
forall a b. (a -> b) -> a -> b
$ \(HiePath FastString
fs,HieAST Int
ast) -> Maybe (HieAST Int) -> First (HieAST Int)
forall a. Maybe a -> First a
First (Maybe (HieAST Int) -> First (HieAST Int))
-> Maybe (HieAST Int) -> First (HieAST Int)
forall a b. (a -> b) -> a -> b
$
case Span -> HieAST Int -> Maybe (HieAST Int)
forall a. Span -> HieAST a -> Maybe (HieAST a)
selectSmallestContaining (FastString -> Span
sp FastString
fs) HieAST Int
ast of
Maybe (HieAST Int)
Nothing -> Maybe (HieAST Int)
forall a. Maybe a
Nothing
Just HieAST Int
ast' -> HieAST Int -> Maybe (HieAST Int)
forall a. a -> Maybe a
Just HieAST Int
ast'
where
sloc :: FastString -> RealSrcLoc
sloc FastString
fs = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
fs Int
sl Int
sc
sp :: FastString -> Span
sp FastString
fs = RealSrcLoc -> RealSrcLoc -> Span
mkRealSrcSpan (FastString -> RealSrcLoc
sloc FastString
fs) (FastString -> RealSrcLoc
sloc FastString
fs)
findEvidenceUse :: NodeIdentifiers a -> [Name]
findEvidenceUse :: forall a. NodeIdentifiers a -> [Name]
findEvidenceUse NodeIdentifiers a
ni = [Name
n | (Right Name
n, IdentifierDetails a
dets) <- [(Identifier, IdentifierDetails a)]
xs, (ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ContextInfo -> Bool
isEvidenceUse (IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
dets)]
where
xs :: [(Identifier, IdentifierDetails a)]
xs = NodeIdentifiers a -> [(Identifier, IdentifierDetails a)]
forall k a. Map k a -> [(k, a)]
M.toList NodeIdentifiers a
ni
data EvidenceInfo a
= EvidenceInfo
{ forall a. EvidenceInfo a -> Name
evidenceVar :: Name
, forall a. EvidenceInfo a -> Span
evidenceSpan :: RealSrcSpan
, forall a. EvidenceInfo a -> a
evidenceType :: a
, forall a. EvidenceInfo a -> Maybe (EvVarSource, Scope, Maybe Span)
evidenceDetails :: Maybe (EvVarSource, Scope, Maybe Span)
} deriving (EvidenceInfo a -> EvidenceInfo a -> Bool
(EvidenceInfo a -> EvidenceInfo a -> Bool)
-> (EvidenceInfo a -> EvidenceInfo a -> Bool)
-> Eq (EvidenceInfo a)
forall a. Eq a => EvidenceInfo a -> EvidenceInfo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => EvidenceInfo a -> EvidenceInfo a -> Bool
== :: EvidenceInfo a -> EvidenceInfo a -> Bool
$c/= :: forall a. Eq a => EvidenceInfo a -> EvidenceInfo a -> Bool
/= :: EvidenceInfo a -> EvidenceInfo a -> Bool
Eq,Eq (EvidenceInfo a)
Eq (EvidenceInfo a) =>
(EvidenceInfo a -> EvidenceInfo a -> Ordering)
-> (EvidenceInfo a -> EvidenceInfo a -> Bool)
-> (EvidenceInfo a -> EvidenceInfo a -> Bool)
-> (EvidenceInfo a -> EvidenceInfo a -> Bool)
-> (EvidenceInfo a -> EvidenceInfo a -> Bool)
-> (EvidenceInfo a -> EvidenceInfo a -> EvidenceInfo a)
-> (EvidenceInfo a -> EvidenceInfo a -> EvidenceInfo a)
-> Ord (EvidenceInfo a)
EvidenceInfo a -> EvidenceInfo a -> Bool
EvidenceInfo a -> EvidenceInfo a -> Ordering
EvidenceInfo a -> EvidenceInfo a -> EvidenceInfo a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (EvidenceInfo a)
forall a. Ord a => EvidenceInfo a -> EvidenceInfo a -> Bool
forall a. Ord a => EvidenceInfo a -> EvidenceInfo a -> Ordering
forall a.
Ord a =>
EvidenceInfo a -> EvidenceInfo a -> EvidenceInfo a
$ccompare :: forall a. Ord a => EvidenceInfo a -> EvidenceInfo a -> Ordering
compare :: EvidenceInfo a -> EvidenceInfo a -> Ordering
$c< :: forall a. Ord a => EvidenceInfo a -> EvidenceInfo a -> Bool
< :: EvidenceInfo a -> EvidenceInfo a -> Bool
$c<= :: forall a. Ord a => EvidenceInfo a -> EvidenceInfo a -> Bool
<= :: EvidenceInfo a -> EvidenceInfo a -> Bool
$c> :: forall a. Ord a => EvidenceInfo a -> EvidenceInfo a -> Bool
> :: EvidenceInfo a -> EvidenceInfo a -> Bool
$c>= :: forall a. Ord a => EvidenceInfo a -> EvidenceInfo a -> Bool
>= :: EvidenceInfo a -> EvidenceInfo a -> Bool
$cmax :: forall a.
Ord a =>
EvidenceInfo a -> EvidenceInfo a -> EvidenceInfo a
max :: EvidenceInfo a -> EvidenceInfo a -> EvidenceInfo a
$cmin :: forall a.
Ord a =>
EvidenceInfo a -> EvidenceInfo a -> EvidenceInfo a
min :: EvidenceInfo a -> EvidenceInfo a -> EvidenceInfo a
Ord,(forall a b. (a -> b) -> EvidenceInfo a -> EvidenceInfo b)
-> (forall a b. a -> EvidenceInfo b -> EvidenceInfo a)
-> Functor EvidenceInfo
forall a b. a -> EvidenceInfo b -> EvidenceInfo a
forall a b. (a -> b) -> EvidenceInfo a -> EvidenceInfo b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> EvidenceInfo a -> EvidenceInfo b
fmap :: forall a b. (a -> b) -> EvidenceInfo a -> EvidenceInfo b
$c<$ :: forall a b. a -> EvidenceInfo b -> EvidenceInfo a
<$ :: forall a b. a -> EvidenceInfo b -> EvidenceInfo a
Functor)
instance (Outputable a) => Outputable (EvidenceInfo a) where
ppr :: EvidenceInfo a -> SDoc
ppr (EvidenceInfo Name
name Span
span a
typ Maybe (EvVarSource, Scope, Maybe Span)
dets) =
SDoc -> Int -> SDoc -> SDoc
hang (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Span -> SDoc
forall a. Outputable a => a -> SDoc
ppr Span
span SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
O.<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
", of type:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
typ) Int
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
SDoc
pdets SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ (Name -> SDoc
pprDefinedAt Name
name)
where
pdets :: SDoc
pdets = case Maybe (EvVarSource, Scope, Maybe Span)
dets of
Maybe (EvVarSource, Scope, Maybe Span)
Nothing -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is a usage of an external evidence variable"
Just (EvVarSource
src,Scope
scp,Maybe Span
spn) -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is an" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ContextInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr (EvVarSource -> Scope -> Maybe Span -> ContextInfo
EvidenceVarBind EvVarSource
src Scope
scp Maybe Span
spn)
getEvidenceTreesAtPoint :: HieFile -> RefMap a -> (Int,Int) -> Tree.Forest (EvidenceInfo a)
getEvidenceTreesAtPoint :: forall a.
HieFile -> RefMap a -> (Int, Int) -> Forest (EvidenceInfo a)
getEvidenceTreesAtPoint HieFile
hf RefMap a
refmap (Int, Int)
point =
[Tree (EvidenceInfo a)
t | Just HieAST Int
ast <- Maybe (HieAST Int) -> [Maybe (HieAST Int)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HieAST Int) -> [Maybe (HieAST Int)])
-> Maybe (HieAST Int) -> [Maybe (HieAST Int)]
forall a b. (a -> b) -> a -> b
$ HieFile -> (Int, Int) -> Maybe (HieAST Int)
selectPoint HieFile
hf (Int, Int)
point
, Name
n <- NodeIdentifiers Int -> [Name]
forall a. NodeIdentifiers a -> [Name]
findEvidenceUse (SourcedNodeInfo Int -> NodeIdentifiers Int
forall a. SourcedNodeInfo a -> NodeIdentifiers a
sourcedNodeIdents (SourcedNodeInfo Int -> NodeIdentifiers Int)
-> SourcedNodeInfo Int -> NodeIdentifiers Int
forall a b. (a -> b) -> a -> b
$ HieAST Int -> SourcedNodeInfo Int
forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo HieAST Int
ast)
, Just Tree (EvidenceInfo a)
t <- Maybe (Tree (EvidenceInfo a)) -> [Maybe (Tree (EvidenceInfo a))]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Tree (EvidenceInfo a)) -> [Maybe (Tree (EvidenceInfo a))])
-> Maybe (Tree (EvidenceInfo a)) -> [Maybe (Tree (EvidenceInfo a))]
forall a b. (a -> b) -> a -> b
$ RefMap a -> Name -> Maybe (Tree (EvidenceInfo a))
forall a. RefMap a -> Name -> Maybe (Tree (EvidenceInfo a))
getEvidenceTree RefMap a
refmap Name
n
]
getEvidenceTree :: RefMap a -> Name -> Maybe (Tree.Tree (EvidenceInfo a))
getEvidenceTree :: forall a. RefMap a -> Name -> Maybe (Tree (EvidenceInfo a))
getEvidenceTree RefMap a
refmap Name
var = NameSet -> Name -> Maybe (Tree (EvidenceInfo a))
go NameSet
emptyNameSet Name
var
where
go :: NameSet -> Name -> Maybe (Tree (EvidenceInfo a))
go NameSet
seen Name
var
| Name
var Name -> NameSet -> Bool
`elemNameSet` NameSet
seen = Maybe (Tree (EvidenceInfo a))
forall a. Maybe a
Nothing
| Bool
otherwise = do
[(Span, IdentifierDetails a)]
xs <- Identifier -> RefMap a -> Maybe [(Span, IdentifierDetails a)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Name -> Identifier
forall a b. b -> Either a b
Right Name
var) RefMap a
refmap
case ((Span, IdentifierDetails a) -> Bool)
-> [(Span, IdentifierDetails a)]
-> Maybe (Span, IdentifierDetails a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ContextInfo -> Bool
isEvidenceBind (Set ContextInfo -> Bool)
-> ((Span, IdentifierDetails a) -> Set ContextInfo)
-> (Span, IdentifierDetails a)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo (IdentifierDetails a -> Set ContextInfo)
-> ((Span, IdentifierDetails a) -> IdentifierDetails a)
-> (Span, IdentifierDetails a)
-> Set ContextInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Span, IdentifierDetails a) -> IdentifierDetails a
forall a b. (a, b) -> b
snd) [(Span, IdentifierDetails a)]
xs of
Just (Span
sp,IdentifierDetails a
dets) -> do
a
typ <- IdentifierDetails a -> Maybe a
forall a. IdentifierDetails a -> Maybe a
identType IdentifierDetails a
dets
((EvVarSource, Scope, Maybe Span)
evdet,[Tree (EvidenceInfo a)]
children) <- First ((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
-> Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
forall a. First a -> Maybe a
getFirst (First ((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
-> Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)]))
-> First
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
-> Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
forall a b. (a -> b) -> a -> b
$ (Maybe ((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
-> First
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)]))
-> [Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])]
-> First
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Maybe ((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
-> First
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
forall a. Maybe a -> First a
First ([Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])]
-> First
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)]))
-> [Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])]
-> First
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
forall a b. (a -> b) -> a -> b
$ do
ContextInfo
det <- Set ContextInfo -> [ContextInfo]
forall a. Set a -> [a]
S.toList (Set ContextInfo -> [ContextInfo])
-> Set ContextInfo -> [ContextInfo]
forall a b. (a -> b) -> a -> b
$ IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
dets
case ContextInfo
det of
EvidenceVarBind src :: EvVarSource
src@(EvLetBind (EvBindDeps -> [Name]
getEvBindDeps -> [Name]
xs)) Scope
scp Maybe Span
spn ->
Maybe ((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
-> [Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
-> [Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])])
-> Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
-> [Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])]
forall a b. (a -> b) -> a -> b
$ ((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
-> Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
forall a. a -> Maybe a
Just ((EvVarSource
src,Scope
scp,Maybe Span
spn),(Name -> Maybe (Tree (EvidenceInfo a)))
-> [Name] -> [Tree (EvidenceInfo a)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (NameSet -> Name -> Maybe (Tree (EvidenceInfo a))
go (NameSet -> Name -> Maybe (Tree (EvidenceInfo a)))
-> NameSet -> Name -> Maybe (Tree (EvidenceInfo a))
forall a b. (a -> b) -> a -> b
$ NameSet -> Name -> NameSet
extendNameSet NameSet
seen Name
var) [Name]
xs)
EvidenceVarBind EvVarSource
src Scope
scp Maybe Span
spn -> Maybe ((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
-> [Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
-> [Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])])
-> Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
-> [Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])]
forall a b. (a -> b) -> a -> b
$ ((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
-> Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
forall a. a -> Maybe a
Just ((EvVarSource
src,Scope
scp,Maybe Span
spn),[])
ContextInfo
_ -> Maybe ((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
-> [Maybe
((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ((EvVarSource, Scope, Maybe Span), [Tree (EvidenceInfo a)])
forall a. Maybe a
Nothing
Tree (EvidenceInfo a) -> Maybe (Tree (EvidenceInfo a))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tree (EvidenceInfo a) -> Maybe (Tree (EvidenceInfo a)))
-> Tree (EvidenceInfo a) -> Maybe (Tree (EvidenceInfo a))
forall a b. (a -> b) -> a -> b
$ EvidenceInfo a -> [Tree (EvidenceInfo a)] -> Tree (EvidenceInfo a)
forall a. a -> [Tree a] -> Tree a
Tree.Node (Name
-> Span
-> a
-> Maybe (EvVarSource, Scope, Maybe Span)
-> EvidenceInfo a
forall a.
Name
-> Span
-> a
-> Maybe (EvVarSource, Scope, Maybe Span)
-> EvidenceInfo a
EvidenceInfo Name
var Span
sp a
typ ((EvVarSource, Scope, Maybe Span)
-> Maybe (EvVarSource, Scope, Maybe Span)
forall a. a -> Maybe a
Just (EvVarSource, Scope, Maybe Span)
evdet)) [Tree (EvidenceInfo a)]
children
Maybe (Span, IdentifierDetails a)
Nothing -> First (Tree (EvidenceInfo a)) -> Maybe (Tree (EvidenceInfo a))
forall a. First a -> Maybe a
getFirst (First (Tree (EvidenceInfo a)) -> Maybe (Tree (EvidenceInfo a)))
-> First (Tree (EvidenceInfo a)) -> Maybe (Tree (EvidenceInfo a))
forall a b. (a -> b) -> a -> b
$ (Maybe (Tree (EvidenceInfo a)) -> First (Tree (EvidenceInfo a)))
-> [Maybe (Tree (EvidenceInfo a))] -> First (Tree (EvidenceInfo a))
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Maybe (Tree (EvidenceInfo a)) -> First (Tree (EvidenceInfo a))
forall a. Maybe a -> First a
First ([Maybe (Tree (EvidenceInfo a))] -> First (Tree (EvidenceInfo a)))
-> [Maybe (Tree (EvidenceInfo a))] -> First (Tree (EvidenceInfo a))
forall a b. (a -> b) -> a -> b
$ do
(Span
sp,IdentifierDetails a
dets) <- [(Span, IdentifierDetails a)]
xs
if ((ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ContextInfo -> Bool
isEvidenceUse (Set ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall a b. (a -> b) -> a -> b
$ IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
dets)
then do
case IdentifierDetails a -> Maybe a
forall a. IdentifierDetails a -> Maybe a
identType IdentifierDetails a
dets of
Maybe a
Nothing -> Maybe (Tree (EvidenceInfo a)) -> [Maybe (Tree (EvidenceInfo a))]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Tree (EvidenceInfo a))
forall a. Maybe a
Nothing
Just a
typ -> Maybe (Tree (EvidenceInfo a)) -> [Maybe (Tree (EvidenceInfo a))]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Tree (EvidenceInfo a)) -> [Maybe (Tree (EvidenceInfo a))])
-> Maybe (Tree (EvidenceInfo a)) -> [Maybe (Tree (EvidenceInfo a))]
forall a b. (a -> b) -> a -> b
$ Tree (EvidenceInfo a) -> Maybe (Tree (EvidenceInfo a))
forall a. a -> Maybe a
Just (Tree (EvidenceInfo a) -> Maybe (Tree (EvidenceInfo a)))
-> Tree (EvidenceInfo a) -> Maybe (Tree (EvidenceInfo a))
forall a b. (a -> b) -> a -> b
$ EvidenceInfo a -> [Tree (EvidenceInfo a)] -> Tree (EvidenceInfo a)
forall a. a -> [Tree a] -> Tree a
Tree.Node (Name
-> Span
-> a
-> Maybe (EvVarSource, Scope, Maybe Span)
-> EvidenceInfo a
forall a.
Name
-> Span
-> a
-> Maybe (EvVarSource, Scope, Maybe Span)
-> EvidenceInfo a
EvidenceInfo Name
var Span
sp a
typ Maybe (EvVarSource, Scope, Maybe Span)
forall a. Maybe a
Nothing) []
else Maybe (Tree (EvidenceInfo a)) -> [Maybe (Tree (EvidenceInfo a))]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Tree (EvidenceInfo a))
forall a. Maybe a
Nothing
hieTypeToIface :: HieTypeFix -> IfaceType
hieTypeToIface :: HieTypeFix -> IfaceType
hieTypeToIface = (HieType IfaceType -> IfaceType) -> HieTypeFix -> IfaceType
forall a. (HieType a -> a) -> HieTypeFix -> a
foldType HieType IfaceType -> IfaceType
go
where
go :: HieType IfaceType -> IfaceType
go (HTyVarTy Name
n) = FastString -> IfaceType
IfaceTyVar (FastString -> IfaceType) -> FastString -> IfaceType
forall a b. (a -> b) -> a -> b
$ OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
n
go (HAppTy IfaceType
a HieArgs IfaceType
b) = IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy IfaceType
a (HieArgs IfaceType -> IfaceAppArgs
hieToIfaceArgs HieArgs IfaceType
b)
go (HLitTy IfaceTyLit
l) = IfaceTyLit -> IfaceType
IfaceLitTy IfaceTyLit
l
go (HForAllTy ((Name
n,IfaceType
k),ForAllTyFlag
af) IfaceType
t) = let b :: (FastString, IfaceType)
b = (OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
n, IfaceType
k)
in IfaceForAllBndr -> IfaceType -> IfaceType
IfaceForAllTy (IfaceBndr -> ForAllTyFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr ((FastString, IfaceType) -> IfaceBndr
IfaceTvBndr (FastString, IfaceType)
b) ForAllTyFlag
af) IfaceType
t
go (HFunTy IfaceType
w IfaceType
a IfaceType
b) = FunTyFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy FunTyFlag
visArgTypeLike IfaceType
w IfaceType
a IfaceType
b
go (HQualTy IfaceType
pred IfaceType
b) = FunTyFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy FunTyFlag
invisArgTypeLike IfaceType
many_ty IfaceType
pred IfaceType
b
go (HCastTy IfaceType
a) = IfaceType
a
go HieType IfaceType
HCoercionTy = FastString -> IfaceType
IfaceTyVar FastString
"<coercion type>"
go (HTyConApp IfaceTyCon
a HieArgs IfaceType
xs) = IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
a (HieArgs IfaceType -> IfaceAppArgs
hieToIfaceArgs HieArgs IfaceType
xs)
hieToIfaceArgs :: HieArgs IfaceType -> IfaceAppArgs
hieToIfaceArgs :: HieArgs IfaceType -> IfaceAppArgs
hieToIfaceArgs (HieArgs [(Bool, IfaceType)]
xs) = [(Bool, IfaceType)] -> IfaceAppArgs
go' [(Bool, IfaceType)]
xs
where
go' :: [(Bool, IfaceType)] -> IfaceAppArgs
go' [] = IfaceAppArgs
IA_Nil
go' ((Bool
True ,IfaceType
x):[(Bool, IfaceType)]
xs) = IfaceType -> ForAllTyFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceType
x ForAllTyFlag
Required (IfaceAppArgs -> IfaceAppArgs) -> IfaceAppArgs -> IfaceAppArgs
forall a b. (a -> b) -> a -> b
$ [(Bool, IfaceType)] -> IfaceAppArgs
go' [(Bool, IfaceType)]
xs
go' ((Bool
False,IfaceType
x):[(Bool, IfaceType)]
xs) = IfaceType -> ForAllTyFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceType
x ForAllTyFlag
Specified (IfaceAppArgs -> IfaceAppArgs) -> IfaceAppArgs -> IfaceAppArgs
forall a b. (a -> b) -> a -> b
$ [(Bool, IfaceType)] -> IfaceAppArgs
go' [(Bool, IfaceType)]
xs
data HieTypeState
= HTS
{ HieTypeState -> TypeMap Int
tyMap :: !(TypeMap TypeIndex)
, HieTypeState -> IntMap HieTypeFlat
htyTable :: !(IM.IntMap HieTypeFlat)
, HieTypeState -> Int
freshIndex :: !TypeIndex
}
initialHTS :: HieTypeState
initialHTS :: HieTypeState
initialHTS = TypeMap Int -> IntMap HieTypeFlat -> Int -> HieTypeState
HTS TypeMap Int
forall a. TypeMap a
emptyTypeMap IntMap HieTypeFlat
forall a. IntMap a
IM.empty Int
0
freshTypeIndex :: State HieTypeState TypeIndex
freshTypeIndex :: State HieTypeState Int
freshTypeIndex = do
Int
index <- (HieTypeState -> Int) -> State HieTypeState Int
forall s a. (s -> a) -> State s a
gets HieTypeState -> Int
freshIndex
(HieTypeState -> HieTypeState) -> State HieTypeState ()
forall s. (s -> s) -> State s ()
modify ((HieTypeState -> HieTypeState) -> State HieTypeState ())
-> (HieTypeState -> HieTypeState) -> State HieTypeState ()
forall a b. (a -> b) -> a -> b
$ \HieTypeState
hts -> HieTypeState
hts { freshIndex = index+1 }
Int -> State HieTypeState Int
forall a. a -> State HieTypeState a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
index
compressTypes
:: HieASTs Type
-> (HieASTs TypeIndex, A.Array TypeIndex HieTypeFlat)
compressTypes :: HieASTs Type -> (HieASTs Int, Array Int HieTypeFlat)
compressTypes HieASTs Type
asts = (HieASTs Int
a, Array Int HieTypeFlat
arr)
where
(HieASTs Int
a, (HTS TypeMap Int
_ IntMap HieTypeFlat
m Int
i)) = (State HieTypeState (HieASTs Int)
-> HieTypeState -> (HieASTs Int, HieTypeState))
-> HieTypeState
-> State HieTypeState (HieASTs Int)
-> (HieASTs Int, HieTypeState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State HieTypeState (HieASTs Int)
-> HieTypeState -> (HieASTs Int, HieTypeState)
forall s a. State s a -> s -> (a, s)
runState HieTypeState
initialHTS (State HieTypeState (HieASTs Int) -> (HieASTs Int, HieTypeState))
-> State HieTypeState (HieASTs Int) -> (HieASTs Int, HieTypeState)
forall a b. (a -> b) -> a -> b
$
HieASTs Type
-> (Type -> State HieTypeState Int)
-> State HieTypeState (HieASTs Int)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for HieASTs Type
asts ((Type -> State HieTypeState Int)
-> State HieTypeState (HieASTs Int))
-> (Type -> State HieTypeState Int)
-> State HieTypeState (HieASTs Int)
forall a b. (a -> b) -> a -> b
$ \Type
typ ->
Type -> State HieTypeState Int
getTypeIndex Type
typ
arr :: Array Int HieTypeFlat
arr = (Int, Int) -> [(Int, HieTypeFlat)] -> Array Int HieTypeFlat
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
A.array (Int
0,Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IntMap HieTypeFlat -> [(Int, HieTypeFlat)]
forall a. IntMap a -> [(Int, a)]
IM.toList IntMap HieTypeFlat
m)
recoverFullType :: TypeIndex -> A.Array TypeIndex HieTypeFlat -> HieTypeFix
recoverFullType :: Int -> Array Int HieTypeFlat -> HieTypeFix
recoverFullType Int
i Array Int HieTypeFlat
m = Int -> HieTypeFix
go Int
i
where
go :: Int -> HieTypeFix
go Int
i = HieType HieTypeFix -> HieTypeFix
Roll (HieType HieTypeFix -> HieTypeFix)
-> HieType HieTypeFix -> HieTypeFix
forall a b. (a -> b) -> a -> b
$ (Int -> HieTypeFix) -> HieTypeFlat -> HieType HieTypeFix
forall a b. (a -> b) -> HieType a -> HieType b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> HieTypeFix
go (Array Int HieTypeFlat
m Array Int HieTypeFlat -> Int -> HieTypeFlat
forall i e. Ix i => Array i e -> i -> e
A.! Int
i)
getTypeIndex :: Type -> State HieTypeState TypeIndex
getTypeIndex :: Type -> State HieTypeState Int
getTypeIndex Type
t
| Bool
otherwise = do
TypeMap Int
tm <- (HieTypeState -> TypeMap Int) -> State HieTypeState (TypeMap Int)
forall s a. (s -> a) -> State s a
gets HieTypeState -> TypeMap Int
tyMap
case TypeMap Int -> Type -> Maybe Int
forall a. TypeMap a -> Type -> Maybe a
lookupTypeMap TypeMap Int
tm Type
t of
Just Int
i -> Int -> State HieTypeState Int
forall a. a -> State HieTypeState a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
Maybe Int
Nothing -> do
HieTypeFlat
ht <- Type -> State HieTypeState HieTypeFlat
go Type
t
Type -> HieTypeFlat -> State HieTypeState Int
extendHTS Type
t HieTypeFlat
ht
where
extendHTS :: Type -> HieTypeFlat -> State HieTypeState Int
extendHTS Type
t HieTypeFlat
ht = do
Int
i <- State HieTypeState Int
freshTypeIndex
(HieTypeState -> HieTypeState) -> State HieTypeState ()
forall s. (s -> s) -> State s ()
modify ((HieTypeState -> HieTypeState) -> State HieTypeState ())
-> (HieTypeState -> HieTypeState) -> State HieTypeState ()
forall a b. (a -> b) -> a -> b
$ \(HTS TypeMap Int
tm IntMap HieTypeFlat
tt Int
fi) ->
TypeMap Int -> IntMap HieTypeFlat -> Int -> HieTypeState
HTS (TypeMap Int -> Type -> Int -> TypeMap Int
forall a. TypeMap a -> Type -> a -> TypeMap a
extendTypeMap TypeMap Int
tm Type
t Int
i) (Int -> HieTypeFlat -> IntMap HieTypeFlat -> IntMap HieTypeFlat
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
i HieTypeFlat
ht IntMap HieTypeFlat
tt) Int
fi
Int -> State HieTypeState Int
forall a. a -> State HieTypeState a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
go :: Type -> State HieTypeState HieTypeFlat
go (TyVarTy TyCoVar
v) = HieTypeFlat -> State HieTypeState HieTypeFlat
forall a. a -> State HieTypeState a
forall (m :: * -> *) a. Monad m => a -> m a
return (HieTypeFlat -> State HieTypeState HieTypeFlat)
-> HieTypeFlat -> State HieTypeState HieTypeFlat
forall a b. (a -> b) -> a -> b
$ Name -> HieTypeFlat
forall a. Name -> HieType a
HTyVarTy (Name -> HieTypeFlat) -> Name -> HieTypeFlat
forall a b. (a -> b) -> a -> b
$ TyCoVar -> Name
varName TyCoVar
v
go ty :: Type
ty@(AppTy Type
_ Type
_) = do
let (Type
head,[Type]
args) = Type -> (Type, [Type])
splitAppTys Type
ty
visArgs :: HieArgs Type
visArgs = [(Bool, Type)] -> HieArgs Type
forall a. [(Bool, a)] -> HieArgs a
HieArgs ([(Bool, Type)] -> HieArgs Type) -> [(Bool, Type)] -> HieArgs Type
forall a b. (a -> b) -> a -> b
$ Type -> [Type] -> [(Bool, Type)]
resolveVisibility ((() :: Constraint) => Type -> Type
Type -> Type
typeKind Type
head) [Type]
args
Int
ai <- Type -> State HieTypeState Int
getTypeIndex Type
head
HieArgs Int
argsi <- (Type -> State HieTypeState Int)
-> HieArgs Type -> State HieTypeState (HieArgs Int)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieArgs a -> m (HieArgs b)
mapM Type -> State HieTypeState Int
getTypeIndex HieArgs Type
visArgs
HieTypeFlat -> State HieTypeState HieTypeFlat
forall a. a -> State HieTypeState a
forall (m :: * -> *) a. Monad m => a -> m a
return (HieTypeFlat -> State HieTypeState HieTypeFlat)
-> HieTypeFlat -> State HieTypeState HieTypeFlat
forall a b. (a -> b) -> a -> b
$ Int -> HieArgs Int -> HieTypeFlat
forall a. a -> HieArgs a -> HieType a
HAppTy Int
ai HieArgs Int
argsi
go (TyConApp TyCon
f [Type]
xs) = do
let visArgs :: HieArgs Type
visArgs = [(Bool, Type)] -> HieArgs Type
forall a. [(Bool, a)] -> HieArgs a
HieArgs ([(Bool, Type)] -> HieArgs Type) -> [(Bool, Type)] -> HieArgs Type
forall a b. (a -> b) -> a -> b
$ Type -> [Type] -> [(Bool, Type)]
resolveVisibility (TyCon -> Type
tyConKind TyCon
f) [Type]
xs
HieArgs Int
is <- (Type -> State HieTypeState Int)
-> HieArgs Type -> State HieTypeState (HieArgs Int)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieArgs a -> m (HieArgs b)
mapM Type -> State HieTypeState Int
getTypeIndex HieArgs Type
visArgs
HieTypeFlat -> State HieTypeState HieTypeFlat
forall a. a -> State HieTypeState a
forall (m :: * -> *) a. Monad m => a -> m a
return (HieTypeFlat -> State HieTypeState HieTypeFlat)
-> HieTypeFlat -> State HieTypeState HieTypeFlat
forall a b. (a -> b) -> a -> b
$ IfaceTyCon -> HieArgs Int -> HieTypeFlat
forall a. IfaceTyCon -> HieArgs a -> HieType a
HTyConApp (TyCon -> IfaceTyCon
toIfaceTyCon TyCon
f) HieArgs Int
is
go (ForAllTy (Bndr TyCoVar
v ForAllTyFlag
a) Type
t) = do
Int
k <- Type -> State HieTypeState Int
getTypeIndex (TyCoVar -> Type
varType TyCoVar
v)
Int
i <- Type -> State HieTypeState Int
getTypeIndex Type
t
HieTypeFlat -> State HieTypeState HieTypeFlat
forall a. a -> State HieTypeState a
forall (m :: * -> *) a. Monad m => a -> m a
return (HieTypeFlat -> State HieTypeState HieTypeFlat)
-> HieTypeFlat -> State HieTypeState HieTypeFlat
forall a b. (a -> b) -> a -> b
$ ((Name, Int), ForAllTyFlag) -> Int -> HieTypeFlat
forall a. ((Name, a), ForAllTyFlag) -> a -> HieType a
HForAllTy ((TyCoVar -> Name
varName TyCoVar
v,Int
k),ForAllTyFlag
a) Int
i
go (FunTy { ft_af :: Type -> FunTyFlag
ft_af = FunTyFlag
af, ft_mult :: Type -> Type
ft_mult = Type
w, ft_arg :: Type -> Type
ft_arg = Type
a, ft_res :: Type -> Type
ft_res = Type
b }) = do
Int
ai <- Type -> State HieTypeState Int
getTypeIndex Type
a
Int
bi <- Type -> State HieTypeState Int
getTypeIndex Type
b
Int
wi <- Type -> State HieTypeState Int
getTypeIndex Type
w
HieTypeFlat -> State HieTypeState HieTypeFlat
forall a. a -> State HieTypeState a
forall (m :: * -> *) a. Monad m => a -> m a
return (HieTypeFlat -> State HieTypeState HieTypeFlat)
-> HieTypeFlat -> State HieTypeState HieTypeFlat
forall a b. (a -> b) -> a -> b
$ if FunTyFlag -> Bool
isInvisibleFunArg FunTyFlag
af
then Bool -> HieTypeFlat -> HieTypeFlat
forall a. HasCallStack => Bool -> a -> a
assert (Type -> Bool
isManyTy Type
w) (HieTypeFlat -> HieTypeFlat) -> HieTypeFlat -> HieTypeFlat
forall a b. (a -> b) -> a -> b
$ Int -> Int -> HieTypeFlat
forall a. a -> a -> HieType a
HQualTy Int
ai Int
bi
else Int -> Int -> Int -> HieTypeFlat
forall a. a -> a -> a -> HieType a
HFunTy Int
wi Int
ai Int
bi
go (LitTy TyLit
a) = HieTypeFlat -> State HieTypeState HieTypeFlat
forall a. a -> State HieTypeState a
forall (m :: * -> *) a. Monad m => a -> m a
return (HieTypeFlat -> State HieTypeState HieTypeFlat)
-> HieTypeFlat -> State HieTypeState HieTypeFlat
forall a b. (a -> b) -> a -> b
$ IfaceTyLit -> HieTypeFlat
forall a. IfaceTyLit -> HieType a
HLitTy (IfaceTyLit -> HieTypeFlat) -> IfaceTyLit -> HieTypeFlat
forall a b. (a -> b) -> a -> b
$ TyLit -> IfaceTyLit
toIfaceTyLit TyLit
a
go (CastTy Type
t KindCoercion
_) = do
Int
i <- Type -> State HieTypeState Int
getTypeIndex Type
t
HieTypeFlat -> State HieTypeState HieTypeFlat
forall a. a -> State HieTypeState a
forall (m :: * -> *) a. Monad m => a -> m a
return (HieTypeFlat -> State HieTypeState HieTypeFlat)
-> HieTypeFlat -> State HieTypeState HieTypeFlat
forall a b. (a -> b) -> a -> b
$ Int -> HieTypeFlat
forall a. a -> HieType a
HCastTy Int
i
go (CoercionTy KindCoercion
_) = HieTypeFlat -> State HieTypeState HieTypeFlat
forall a. a -> State HieTypeState a
forall (m :: * -> *) a. Monad m => a -> m a
return HieTypeFlat
forall a. HieType a
HCoercionTy
resolveTyVarScopes :: M.Map HiePath (HieAST a) -> M.Map HiePath (HieAST a)
resolveTyVarScopes :: forall a. Map HiePath (HieAST a) -> Map HiePath (HieAST a)
resolveTyVarScopes Map HiePath (HieAST a)
asts = (HieAST a -> HieAST a)
-> Map HiePath (HieAST a) -> Map HiePath (HieAST a)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map HieAST a -> HieAST a
go Map HiePath (HieAST a)
asts
where
go :: HieAST a -> HieAST a
go HieAST a
ast = HieAST a -> Map HiePath (HieAST a) -> HieAST a
forall a. HieAST a -> Map HiePath (HieAST a) -> HieAST a
resolveTyVarScopeLocal HieAST a
ast Map HiePath (HieAST a)
asts
resolveTyVarScopeLocal :: HieAST a -> M.Map HiePath (HieAST a) -> HieAST a
resolveTyVarScopeLocal :: forall a. HieAST a -> Map HiePath (HieAST a) -> HieAST a
resolveTyVarScopeLocal HieAST a
ast Map HiePath (HieAST a)
asts = HieAST a -> HieAST a
go HieAST a
ast
where
resolveNameScope :: IdentifierDetails a -> IdentifierDetails a
resolveNameScope IdentifierDetails a
dets = IdentifierDetails a
dets{identInfo =
S.map resolveScope (identInfo dets)}
resolveScope :: ContextInfo -> ContextInfo
resolveScope (TyVarBind Scope
sc (UnresolvedScope [Name]
names Maybe Span
Nothing)) =
Scope -> TyVarScope -> ContextInfo
TyVarBind Scope
sc (TyVarScope -> ContextInfo) -> TyVarScope -> ContextInfo
forall a b. (a -> b) -> a -> b
$ [Scope] -> TyVarScope
ResolvedScopes
[ Span -> Scope
LocalScope Span
binding
| Name
name <- [Name]
names
, Just Span
binding <- [Name -> Map HiePath (HieAST a) -> Maybe Span
forall a. Name -> Map HiePath (HieAST a) -> Maybe Span
getNameBinding Name
name Map HiePath (HieAST a)
asts]
]
resolveScope (TyVarBind Scope
sc (UnresolvedScope [Name]
names (Just Span
sp))) =
Scope -> TyVarScope -> ContextInfo
TyVarBind Scope
sc (TyVarScope -> ContextInfo) -> TyVarScope -> ContextInfo
forall a b. (a -> b) -> a -> b
$ [Scope] -> TyVarScope
ResolvedScopes
[ Span -> Scope
LocalScope Span
binding
| Name
name <- [Name]
names
, Just Span
binding <- [Name -> Span -> Map HiePath (HieAST a) -> Maybe Span
forall a. Name -> Span -> Map HiePath (HieAST a) -> Maybe Span
getNameBindingInClass Name
name Span
sp Map HiePath (HieAST a)
asts]
]
resolveScope ContextInfo
scope = ContextInfo
scope
go :: HieAST a -> HieAST a
go (Node SourcedNodeInfo a
info Span
span [HieAST a]
children) = SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
forall a. SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
Node SourcedNodeInfo a
info' Span
span ([HieAST a] -> HieAST a) -> [HieAST a] -> HieAST a
forall a b. (a -> b) -> a -> b
$ (HieAST a -> HieAST a) -> [HieAST a] -> [HieAST a]
forall a b. (a -> b) -> [a] -> [b]
map HieAST a -> HieAST a
go [HieAST a]
children
where
info' :: SourcedNodeInfo a
info' = Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
forall a. Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
SourcedNodeInfo (NodeInfo a -> NodeInfo a
updateNodeInfo (NodeInfo a -> NodeInfo a)
-> Map NodeOrigin (NodeInfo a) -> Map NodeOrigin (NodeInfo a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo SourcedNodeInfo a
info)
updateNodeInfo :: NodeInfo a -> NodeInfo a
updateNodeInfo NodeInfo a
i = NodeInfo a
i { nodeIdentifiers = idents }
where
idents :: Map Identifier (IdentifierDetails a)
idents = (IdentifierDetails a -> IdentifierDetails a)
-> Map Identifier (IdentifierDetails a)
-> Map Identifier (IdentifierDetails a)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map IdentifierDetails a -> IdentifierDetails a
resolveNameScope (Map Identifier (IdentifierDetails a)
-> Map Identifier (IdentifierDetails a))
-> Map Identifier (IdentifierDetails a)
-> Map Identifier (IdentifierDetails a)
forall a b. (a -> b) -> a -> b
$ NodeInfo a -> Map Identifier (IdentifierDetails a)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo a
i
getNameBinding :: Name -> M.Map HiePath (HieAST a) -> Maybe Span
getNameBinding :: forall a. Name -> Map HiePath (HieAST a) -> Maybe Span
getNameBinding Name
n Map HiePath (HieAST a)
asts = do
([Scope]
_,Maybe Span
msp) <- Name -> Map HiePath (HieAST a) -> Maybe ([Scope], Maybe Span)
forall a.
Name -> Map HiePath (HieAST a) -> Maybe ([Scope], Maybe Span)
getNameScopeAndBinding Name
n Map HiePath (HieAST a)
asts
Maybe Span
msp
getNameScope :: Name -> M.Map HiePath (HieAST a) -> Maybe [Scope]
getNameScope :: forall a. Name -> Map HiePath (HieAST a) -> Maybe [Scope]
getNameScope Name
n Map HiePath (HieAST a)
asts = do
([Scope]
scopes,Maybe Span
_) <- Name -> Map HiePath (HieAST a) -> Maybe ([Scope], Maybe Span)
forall a.
Name -> Map HiePath (HieAST a) -> Maybe ([Scope], Maybe Span)
getNameScopeAndBinding Name
n Map HiePath (HieAST a)
asts
[Scope] -> Maybe [Scope]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [Scope]
scopes
getNameBindingInClass
:: Name
-> Span
-> M.Map HiePath (HieAST a)
-> Maybe Span
getNameBindingInClass :: forall a. Name -> Span -> Map HiePath (HieAST a) -> Maybe Span
getNameBindingInClass Name
n Span
sp Map HiePath (HieAST a)
asts = do
HieAST a
ast <- HiePath -> Map HiePath (HieAST a) -> Maybe (HieAST a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (FastString -> HiePath
HiePath (Span -> FastString
srcSpanFile Span
sp)) Map HiePath (HieAST a)
asts
HieAST a
clsNode <- Span -> HieAST a -> Maybe (HieAST a)
forall a. Span -> HieAST a -> Maybe (HieAST a)
selectLargestContainedBy Span
sp HieAST a
ast
First Span -> Maybe Span
forall a. First a -> Maybe a
getFirst (First Span -> Maybe Span) -> First Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ (Maybe Span -> First Span) -> [Maybe Span] -> First Span
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Maybe Span -> First Span
forall a. Maybe a -> First a
First ([Maybe Span] -> First Span) -> [Maybe Span] -> First Span
forall a b. (a -> b) -> a -> b
$ do
HieAST a
child <- HieAST a -> [HieAST a]
forall a. HieAST a -> [HieAST a]
flattenAst HieAST a
clsNode
IdentifierDetails a
dets <- Maybe (IdentifierDetails a) -> [IdentifierDetails a]
forall a. Maybe a -> [a]
maybeToList
(Maybe (IdentifierDetails a) -> [IdentifierDetails a])
-> Maybe (IdentifierDetails a) -> [IdentifierDetails a]
forall a b. (a -> b) -> a -> b
$ Identifier
-> Map Identifier (IdentifierDetails a)
-> Maybe (IdentifierDetails a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Name -> Identifier
forall a b. b -> Either a b
Right Name
n) (Map Identifier (IdentifierDetails a)
-> Maybe (IdentifierDetails a))
-> Map Identifier (IdentifierDetails a)
-> Maybe (IdentifierDetails a)
forall a b. (a -> b) -> a -> b
$ SourcedNodeInfo a -> Map Identifier (IdentifierDetails a)
forall a. SourcedNodeInfo a -> NodeIdentifiers a
sourcedNodeIdents (SourcedNodeInfo a -> Map Identifier (IdentifierDetails a))
-> SourcedNodeInfo a -> Map Identifier (IdentifierDetails a)
forall a b. (a -> b) -> a -> b
$ HieAST a -> SourcedNodeInfo a
forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo HieAST a
child
let binding :: First Span
binding = (ContextInfo -> First Span) -> Set ContextInfo -> First Span
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe Span -> First Span
forall a. Maybe a -> First a
First (Maybe Span -> First Span)
-> (ContextInfo -> Maybe Span) -> ContextInfo -> First Span
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextInfo -> Maybe Span
getBindSiteFromContext) (IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
dets)
Maybe Span -> [Maybe Span]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (First Span -> Maybe Span
forall a. First a -> Maybe a
getFirst First Span
binding)
getNameScopeAndBinding
:: Name
-> M.Map HiePath (HieAST a)
-> Maybe ([Scope], Maybe Span)
getNameScopeAndBinding :: forall a.
Name -> Map HiePath (HieAST a) -> Maybe ([Scope], Maybe Span)
getNameScopeAndBinding Name
n Map HiePath (HieAST a)
asts = case Name -> SrcSpan
nameSrcSpan Name
n of
RealSrcSpan Span
sp Maybe BufSpan
_ -> do
HieAST a
ast <- HiePath -> Map HiePath (HieAST a) -> Maybe (HieAST a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (FastString -> HiePath
HiePath (Span -> FastString
srcSpanFile Span
sp)) Map HiePath (HieAST a)
asts
HieAST a
defNode <- Span -> HieAST a -> Maybe (HieAST a)
forall a. Span -> HieAST a -> Maybe (HieAST a)
selectLargestContainedBy Span
sp HieAST a
ast
First ([Scope], Maybe Span) -> Maybe ([Scope], Maybe Span)
forall a. First a -> Maybe a
getFirst (First ([Scope], Maybe Span) -> Maybe ([Scope], Maybe Span))
-> First ([Scope], Maybe Span) -> Maybe ([Scope], Maybe Span)
forall a b. (a -> b) -> a -> b
$ (Maybe ([Scope], Maybe Span) -> First ([Scope], Maybe Span))
-> [Maybe ([Scope], Maybe Span)] -> First ([Scope], Maybe Span)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Maybe ([Scope], Maybe Span) -> First ([Scope], Maybe Span)
forall a. Maybe a -> First a
First ([Maybe ([Scope], Maybe Span)] -> First ([Scope], Maybe Span))
-> [Maybe ([Scope], Maybe Span)] -> First ([Scope], Maybe Span)
forall a b. (a -> b) -> a -> b
$ do
HieAST a
node <- HieAST a -> [HieAST a]
forall a. HieAST a -> [HieAST a]
flattenAst HieAST a
defNode
IdentifierDetails a
dets <- Maybe (IdentifierDetails a) -> [IdentifierDetails a]
forall a. Maybe a -> [a]
maybeToList
(Maybe (IdentifierDetails a) -> [IdentifierDetails a])
-> Maybe (IdentifierDetails a) -> [IdentifierDetails a]
forall a b. (a -> b) -> a -> b
$ Identifier
-> Map Identifier (IdentifierDetails a)
-> Maybe (IdentifierDetails a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Name -> Identifier
forall a b. b -> Either a b
Right Name
n) (Map Identifier (IdentifierDetails a)
-> Maybe (IdentifierDetails a))
-> Map Identifier (IdentifierDetails a)
-> Maybe (IdentifierDetails a)
forall a b. (a -> b) -> a -> b
$ SourcedNodeInfo a -> Map Identifier (IdentifierDetails a)
forall a. SourcedNodeInfo a -> NodeIdentifiers a
sourcedNodeIdents (SourcedNodeInfo a -> Map Identifier (IdentifierDetails a))
-> SourcedNodeInfo a -> Map Identifier (IdentifierDetails a)
forall a b. (a -> b) -> a -> b
$ HieAST a -> SourcedNodeInfo a
forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo HieAST a
node
[Scope]
scopes <- Maybe [Scope] -> [[Scope]]
forall a. Maybe a -> [a]
maybeToList (Maybe [Scope] -> [[Scope]]) -> Maybe [Scope] -> [[Scope]]
forall a b. (a -> b) -> a -> b
$ (ContextInfo -> Maybe [Scope]) -> Set ContextInfo -> Maybe [Scope]
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ContextInfo -> Maybe [Scope]
getScopeFromContext (IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
dets)
let binding :: First Span
binding = (ContextInfo -> First Span) -> Set ContextInfo -> First Span
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe Span -> First Span
forall a. Maybe a -> First a
First (Maybe Span -> First Span)
-> (ContextInfo -> Maybe Span) -> ContextInfo -> First Span
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextInfo -> Maybe Span
getBindSiteFromContext) (IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
dets)
Maybe ([Scope], Maybe Span) -> [Maybe ([Scope], Maybe Span)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ([Scope], Maybe Span) -> [Maybe ([Scope], Maybe Span)])
-> Maybe ([Scope], Maybe Span) -> [Maybe ([Scope], Maybe Span)]
forall a b. (a -> b) -> a -> b
$ ([Scope], Maybe Span) -> Maybe ([Scope], Maybe Span)
forall a. a -> Maybe a
Just ([Scope]
scopes, First Span -> Maybe Span
forall a. First a -> Maybe a
getFirst First Span
binding)
SrcSpan
_ -> Maybe ([Scope], Maybe Span)
forall a. Maybe a
Nothing
getScopeFromContext :: ContextInfo -> Maybe [Scope]
getScopeFromContext :: ContextInfo -> Maybe [Scope]
getScopeFromContext (ValBind BindType
_ Scope
sc Maybe Span
_) = [Scope] -> Maybe [Scope]
forall a. a -> Maybe a
Just [Scope
sc]
getScopeFromContext (PatternBind Scope
a Scope
b Maybe Span
_) = [Scope] -> Maybe [Scope]
forall a. a -> Maybe a
Just [Scope
a, Scope
b]
getScopeFromContext (ClassTyDecl Maybe Span
_) = [Scope] -> Maybe [Scope]
forall a. a -> Maybe a
Just [Scope
ModuleScope]
getScopeFromContext (Decl DeclType
_ Maybe Span
_) = [Scope] -> Maybe [Scope]
forall a. a -> Maybe a
Just [Scope
ModuleScope]
getScopeFromContext (TyVarBind Scope
a (ResolvedScopes [Scope]
xs)) = [Scope] -> Maybe [Scope]
forall a. a -> Maybe a
Just ([Scope] -> Maybe [Scope]) -> [Scope] -> Maybe [Scope]
forall a b. (a -> b) -> a -> b
$ Scope
aScope -> [Scope] -> [Scope]
forall a. a -> [a] -> [a]
:[Scope]
xs
getScopeFromContext (TyVarBind Scope
a TyVarScope
_) = [Scope] -> Maybe [Scope]
forall a. a -> Maybe a
Just [Scope
a]
getScopeFromContext (EvidenceVarBind EvVarSource
_ Scope
a Maybe Span
_) = [Scope] -> Maybe [Scope]
forall a. a -> Maybe a
Just [Scope
a]
getScopeFromContext ContextInfo
_ = Maybe [Scope]
forall a. Maybe a
Nothing
getBindSiteFromContext :: ContextInfo -> Maybe Span
getBindSiteFromContext :: ContextInfo -> Maybe Span
getBindSiteFromContext (ValBind BindType
_ Scope
_ Maybe Span
sp) = Maybe Span
sp
getBindSiteFromContext (PatternBind Scope
_ Scope
_ Maybe Span
sp) = Maybe Span
sp
getBindSiteFromContext ContextInfo
_ = Maybe Span
forall a. Maybe a
Nothing
flattenAst :: HieAST a -> [HieAST a]
flattenAst :: forall a. HieAST a -> [HieAST a]
flattenAst HieAST a
n =
HieAST a
n HieAST a -> [HieAST a] -> [HieAST a]
forall a. a -> [a] -> [a]
: (HieAST a -> [HieAST a]) -> [HieAST a] -> [HieAST a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap HieAST a -> [HieAST a]
forall a. HieAST a -> [HieAST a]
flattenAst (HieAST a -> [HieAST a]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST a
n)
smallestContainingSatisfying
:: Span
-> (HieAST a -> Bool)
-> HieAST a
-> Maybe (HieAST a)
smallestContainingSatisfying :: forall a.
Span -> (HieAST a -> Bool) -> HieAST a -> Maybe (HieAST a)
smallestContainingSatisfying Span
sp HieAST a -> Bool
cond HieAST a
node
| HieAST a -> Span
forall a. HieAST a -> Span
nodeSpan HieAST a
node Span -> Span -> Bool
`containsSpan` Span
sp = First (HieAST a) -> Maybe (HieAST a)
forall a. First a -> Maybe a
getFirst (First (HieAST a) -> Maybe (HieAST a))
-> First (HieAST a) -> Maybe (HieAST a)
forall a b. (a -> b) -> a -> b
$ [First (HieAST a)] -> First (HieAST a)
forall a. Monoid a => [a] -> a
mconcat
[ (HieAST a -> First (HieAST a)) -> [HieAST a] -> First (HieAST a)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe (HieAST a) -> First (HieAST a)
forall a. Maybe a -> First a
First (Maybe (HieAST a) -> First (HieAST a))
-> (HieAST a -> Maybe (HieAST a)) -> HieAST a -> First (HieAST a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> (HieAST a -> Bool) -> HieAST a -> Maybe (HieAST a)
forall a.
Span -> (HieAST a -> Bool) -> HieAST a -> Maybe (HieAST a)
smallestContainingSatisfying Span
sp HieAST a -> Bool
cond) ([HieAST a] -> First (HieAST a)) -> [HieAST a] -> First (HieAST a)
forall a b. (a -> b) -> a -> b
$
HieAST a -> [HieAST a]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST a
node
, Maybe (HieAST a) -> First (HieAST a)
forall a. Maybe a -> First a
First (Maybe (HieAST a) -> First (HieAST a))
-> Maybe (HieAST a) -> First (HieAST a)
forall a b. (a -> b) -> a -> b
$ if HieAST a -> Bool
cond HieAST a
node then HieAST a -> Maybe (HieAST a)
forall a. a -> Maybe a
Just HieAST a
node else Maybe (HieAST a)
forall a. Maybe a
Nothing
]
| Span
sp Span -> Span -> Bool
`containsSpan` HieAST a -> Span
forall a. HieAST a -> Span
nodeSpan HieAST a
node = Maybe (HieAST a)
forall a. Maybe a
Nothing
| Bool
otherwise = Maybe (HieAST a)
forall a. Maybe a
Nothing
selectLargestContainedBy :: Span -> HieAST a -> Maybe (HieAST a)
selectLargestContainedBy :: forall a. Span -> HieAST a -> Maybe (HieAST a)
selectLargestContainedBy Span
sp HieAST a
node
| Span
sp Span -> Span -> Bool
`containsSpan` HieAST a -> Span
forall a. HieAST a -> Span
nodeSpan HieAST a
node = HieAST a -> Maybe (HieAST a)
forall a. a -> Maybe a
Just HieAST a
node
| HieAST a -> Span
forall a. HieAST a -> Span
nodeSpan HieAST a
node Span -> Span -> Bool
`containsSpan` Span
sp =
First (HieAST a) -> Maybe (HieAST a)
forall a. First a -> Maybe a
getFirst (First (HieAST a) -> Maybe (HieAST a))
-> First (HieAST a) -> Maybe (HieAST a)
forall a b. (a -> b) -> a -> b
$ (HieAST a -> First (HieAST a)) -> [HieAST a] -> First (HieAST a)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe (HieAST a) -> First (HieAST a)
forall a. Maybe a -> First a
First (Maybe (HieAST a) -> First (HieAST a))
-> (HieAST a -> Maybe (HieAST a)) -> HieAST a -> First (HieAST a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> HieAST a -> Maybe (HieAST a)
forall a. Span -> HieAST a -> Maybe (HieAST a)
selectLargestContainedBy Span
sp) ([HieAST a] -> First (HieAST a)) -> [HieAST a] -> First (HieAST a)
forall a b. (a -> b) -> a -> b
$
HieAST a -> [HieAST a]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST a
node
| Bool
otherwise = Maybe (HieAST a)
forall a. Maybe a
Nothing
selectSmallestContaining :: Span -> HieAST a -> Maybe (HieAST a)
selectSmallestContaining :: forall a. Span -> HieAST a -> Maybe (HieAST a)
selectSmallestContaining Span
sp HieAST a
node
| HieAST a -> Span
forall a. HieAST a -> Span
nodeSpan HieAST a
node Span -> Span -> Bool
`containsSpan` Span
sp = First (HieAST a) -> Maybe (HieAST a)
forall a. First a -> Maybe a
getFirst (First (HieAST a) -> Maybe (HieAST a))
-> First (HieAST a) -> Maybe (HieAST a)
forall a b. (a -> b) -> a -> b
$ [First (HieAST a)] -> First (HieAST a)
forall a. Monoid a => [a] -> a
mconcat
[ (HieAST a -> First (HieAST a)) -> [HieAST a] -> First (HieAST a)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe (HieAST a) -> First (HieAST a)
forall a. Maybe a -> First a
First (Maybe (HieAST a) -> First (HieAST a))
-> (HieAST a -> Maybe (HieAST a)) -> HieAST a -> First (HieAST a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> HieAST a -> Maybe (HieAST a)
forall a. Span -> HieAST a -> Maybe (HieAST a)
selectSmallestContaining Span
sp) ([HieAST a] -> First (HieAST a)) -> [HieAST a] -> First (HieAST a)
forall a b. (a -> b) -> a -> b
$ HieAST a -> [HieAST a]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST a
node
, Maybe (HieAST a) -> First (HieAST a)
forall a. Maybe a -> First a
First (HieAST a -> Maybe (HieAST a)
forall a. a -> Maybe a
Just HieAST a
node)
]
| Span
sp Span -> Span -> Bool
`containsSpan` HieAST a -> Span
forall a. HieAST a -> Span
nodeSpan HieAST a
node = Maybe (HieAST a)
forall a. Maybe a
Nothing
| Bool
otherwise = Maybe (HieAST a)
forall a. Maybe a
Nothing
definedInAsts :: M.Map HiePath (HieAST a) -> Name -> Bool
definedInAsts :: forall a. Map HiePath (HieAST a) -> Name -> Bool
definedInAsts Map HiePath (HieAST a)
asts Name
n = case Name -> SrcSpan
nameSrcSpan Name
n of
RealSrcSpan Span
sp Maybe BufSpan
_ -> HiePath -> Map HiePath (HieAST a) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member (FastString -> HiePath
HiePath (Span -> FastString
srcSpanFile Span
sp)) Map HiePath (HieAST a)
asts
SrcSpan
_ -> Bool
False
getEvidenceBindDeps :: ContextInfo -> [Name]
getEvidenceBindDeps :: ContextInfo -> [Name]
getEvidenceBindDeps (EvidenceVarBind (EvLetBind EvBindDeps
xs) Scope
_ Maybe Span
_) =
EvBindDeps -> [Name]
getEvBindDeps EvBindDeps
xs
getEvidenceBindDeps ContextInfo
_ = []
isEvidenceBind :: ContextInfo -> Bool
isEvidenceBind :: ContextInfo -> Bool
isEvidenceBind EvidenceVarBind{} = Bool
True
isEvidenceBind ContextInfo
_ = Bool
False
isEvidenceContext :: ContextInfo -> Bool
isEvidenceContext :: ContextInfo -> Bool
isEvidenceContext ContextInfo
EvidenceVarUse = Bool
True
isEvidenceContext EvidenceVarBind{} = Bool
True
isEvidenceContext ContextInfo
_ = Bool
False
isEvidenceUse :: ContextInfo -> Bool
isEvidenceUse :: ContextInfo -> Bool
isEvidenceUse ContextInfo
EvidenceVarUse = Bool
True
isEvidenceUse ContextInfo
_ = Bool
False
isOccurrence :: ContextInfo -> Bool
isOccurrence :: ContextInfo -> Bool
isOccurrence ContextInfo
Use = Bool
True
isOccurrence ContextInfo
EvidenceVarUse = Bool
True
isOccurrence ContextInfo
_ = Bool
False
scopeContainsSpan :: Scope -> Span -> Bool
scopeContainsSpan :: Scope -> Span -> Bool
scopeContainsSpan Scope
NoScope Span
_ = Bool
False
scopeContainsSpan Scope
ModuleScope Span
_ = Bool
True
scopeContainsSpan (LocalScope Span
a) Span
b = Span
a Span -> Span -> Bool
`containsSpan` Span
b
combineAst :: HieAST Type -> HieAST Type -> HieAST Type
combineAst :: HieAST Type -> HieAST Type -> HieAST Type
combineAst a :: HieAST Type
a@(Node SourcedNodeInfo Type
aInf Span
aSpn [HieAST Type]
xs) b :: HieAST Type
b@(Node SourcedNodeInfo Type
bInf Span
bSpn [HieAST Type]
ys)
| Span
aSpn Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
== Span
bSpn = SourcedNodeInfo Type -> Span -> [HieAST Type] -> HieAST Type
forall a. SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
Node (SourcedNodeInfo Type
aInf SourcedNodeInfo Type
-> SourcedNodeInfo Type -> SourcedNodeInfo Type
`combineSourcedNodeInfo` SourcedNodeInfo Type
bInf) Span
aSpn ([HieAST Type] -> [HieAST Type] -> [HieAST Type]
mergeAsts [HieAST Type]
xs [HieAST Type]
ys)
| Span
aSpn Span -> Span -> Bool
`containsSpan` Span
bSpn = HieAST Type -> HieAST Type -> HieAST Type
combineAst HieAST Type
b HieAST Type
a
combineAst HieAST Type
a (Node SourcedNodeInfo Type
xs Span
span [HieAST Type]
children) = SourcedNodeInfo Type -> Span -> [HieAST Type] -> HieAST Type
forall a. SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
Node SourcedNodeInfo Type
xs Span
span (HieAST Type -> [HieAST Type] -> [HieAST Type]
insertAst HieAST Type
a [HieAST Type]
children)
insertAst :: HieAST Type -> [HieAST Type] -> [HieAST Type]
insertAst :: HieAST Type -> [HieAST Type] -> [HieAST Type]
insertAst HieAST Type
x = [HieAST Type] -> [HieAST Type] -> [HieAST Type]
mergeAsts [HieAST Type
x]
nodeInfo :: HieAST Type -> NodeInfo Type
nodeInfo :: HieAST Type -> NodeInfo Type
nodeInfo = (NodeInfo Type -> NodeInfo Type -> NodeInfo Type)
-> NodeInfo Type -> Map NodeOrigin (NodeInfo Type) -> NodeInfo Type
forall b a. (b -> a -> b) -> b -> Map NodeOrigin a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' NodeInfo Type -> NodeInfo Type -> NodeInfo Type
combineNodeInfo NodeInfo Type
forall a. NodeInfo a
emptyNodeInfo (Map NodeOrigin (NodeInfo Type) -> NodeInfo Type)
-> (HieAST Type -> Map NodeOrigin (NodeInfo Type))
-> HieAST Type
-> NodeInfo Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcedNodeInfo Type -> Map NodeOrigin (NodeInfo Type)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo (SourcedNodeInfo Type -> Map NodeOrigin (NodeInfo Type))
-> (HieAST Type -> SourcedNodeInfo Type)
-> HieAST Type
-> Map NodeOrigin (NodeInfo Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST Type -> SourcedNodeInfo Type
forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo
emptyNodeInfo :: NodeInfo a
emptyNodeInfo :: forall a. NodeInfo a
emptyNodeInfo = Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
forall a.
Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
NodeInfo Set NodeAnnotation
forall a. Set a
S.empty [] NodeIdentifiers a
forall k a. Map k a
M.empty
sourcedNodeIdents :: SourcedNodeInfo a -> NodeIdentifiers a
sourcedNodeIdents :: forall a. SourcedNodeInfo a -> NodeIdentifiers a
sourcedNodeIdents = (IdentifierDetails a -> IdentifierDetails a -> IdentifierDetails a)
-> Map NodeOrigin (Map Identifier (IdentifierDetails a))
-> Map Identifier (IdentifierDetails a)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith IdentifierDetails a -> IdentifierDetails a -> IdentifierDetails a
forall a. Semigroup a => a -> a -> a
(<>) (Map NodeOrigin (Map Identifier (IdentifierDetails a))
-> Map Identifier (IdentifierDetails a))
-> (SourcedNodeInfo a
-> Map NodeOrigin (Map Identifier (IdentifierDetails a)))
-> SourcedNodeInfo a
-> Map Identifier (IdentifierDetails a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeInfo a -> Map Identifier (IdentifierDetails a))
-> Map NodeOrigin (NodeInfo a)
-> Map NodeOrigin (Map Identifier (IdentifierDetails a))
forall a b. (a -> b) -> Map NodeOrigin a -> Map NodeOrigin b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeInfo a -> Map Identifier (IdentifierDetails a)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers (Map NodeOrigin (NodeInfo a)
-> Map NodeOrigin (Map Identifier (IdentifierDetails a)))
-> (SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a))
-> SourcedNodeInfo a
-> Map NodeOrigin (Map Identifier (IdentifierDetails a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo
combineSourcedNodeInfo :: SourcedNodeInfo Type -> SourcedNodeInfo Type -> SourcedNodeInfo Type
combineSourcedNodeInfo :: SourcedNodeInfo Type
-> SourcedNodeInfo Type -> SourcedNodeInfo Type
combineSourcedNodeInfo = (Map NodeOrigin (NodeInfo Type)
-> Map NodeOrigin (NodeInfo Type)
-> Map NodeOrigin (NodeInfo Type))
-> SourcedNodeInfo Type
-> SourcedNodeInfo Type
-> SourcedNodeInfo Type
forall a b. Coercible a b => a -> b
coerce ((Map NodeOrigin (NodeInfo Type)
-> Map NodeOrigin (NodeInfo Type)
-> Map NodeOrigin (NodeInfo Type))
-> SourcedNodeInfo Type
-> SourcedNodeInfo Type
-> SourcedNodeInfo Type)
-> (Map NodeOrigin (NodeInfo Type)
-> Map NodeOrigin (NodeInfo Type)
-> Map NodeOrigin (NodeInfo Type))
-> SourcedNodeInfo Type
-> SourcedNodeInfo Type
-> SourcedNodeInfo Type
forall a b. (a -> b) -> a -> b
$ (NodeInfo Type -> NodeInfo Type -> NodeInfo Type)
-> Map NodeOrigin (NodeInfo Type)
-> Map NodeOrigin (NodeInfo Type)
-> Map NodeOrigin (NodeInfo Type)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith NodeInfo Type -> NodeInfo Type -> NodeInfo Type
combineNodeInfo
combineNodeInfo :: NodeInfo Type -> NodeInfo Type -> NodeInfo Type
(NodeInfo Set NodeAnnotation
as [Type]
ai NodeIdentifiers Type
ad) combineNodeInfo :: NodeInfo Type -> NodeInfo Type -> NodeInfo Type
`combineNodeInfo` (NodeInfo Set NodeAnnotation
bs [Type]
bi NodeIdentifiers Type
bd) =
Set NodeAnnotation
-> [Type] -> NodeIdentifiers Type -> NodeInfo Type
forall a.
Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
NodeInfo (Set NodeAnnotation -> Set NodeAnnotation -> Set NodeAnnotation
forall a. Ord a => Set a -> Set a -> Set a
S.union Set NodeAnnotation
as Set NodeAnnotation
bs) ([Type] -> [Type] -> [Type]
mergeSorted [Type]
ai [Type]
bi) ((IdentifierDetails Type
-> IdentifierDetails Type -> IdentifierDetails Type)
-> NodeIdentifiers Type
-> NodeIdentifiers Type
-> NodeIdentifiers Type
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith IdentifierDetails Type
-> IdentifierDetails Type -> IdentifierDetails Type
forall a. Semigroup a => a -> a -> a
(<>) NodeIdentifiers Type
ad NodeIdentifiers Type
bd)
where
mergeSorted :: [Type] -> [Type] -> [Type]
mergeSorted :: [Type] -> [Type] -> [Type]
mergeSorted la :: [Type]
la@(Type
a:[Type]
as) lb :: [Type]
lb@(Type
b:[Type]
bs) = case Type -> Type -> Ordering
nonDetCmpType Type
a Type
b of
Ordering
LT -> Type
a Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: [Type] -> [Type] -> [Type]
mergeSorted [Type]
as [Type]
lb
Ordering
EQ -> Type
a Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: [Type] -> [Type] -> [Type]
mergeSorted [Type]
as [Type]
bs
Ordering
GT -> Type
b Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: [Type] -> [Type] -> [Type]
mergeSorted [Type]
la [Type]
bs
mergeSorted [Type]
as [] = [Type]
as
mergeSorted [] [Type]
bs = [Type]
bs
mergeAsts :: [HieAST Type] -> [HieAST Type] -> [HieAST Type]
mergeAsts :: [HieAST Type] -> [HieAST Type] -> [HieAST Type]
mergeAsts [HieAST Type]
xs [] = [HieAST Type]
xs
mergeAsts [] [HieAST Type]
ys = [HieAST Type]
ys
mergeAsts xs :: [HieAST Type]
xs@(HieAST Type
a:[HieAST Type]
as) ys :: [HieAST Type]
ys@(HieAST Type
b:[HieAST Type]
bs)
| Span
span_a Span -> Span -> Bool
`containsSpan` Span
span_b = [HieAST Type] -> [HieAST Type] -> [HieAST Type]
mergeAsts (HieAST Type -> HieAST Type -> HieAST Type
combineAst HieAST Type
a HieAST Type
b HieAST Type -> [HieAST Type] -> [HieAST Type]
forall a. a -> [a] -> [a]
: [HieAST Type]
as) [HieAST Type]
bs
| Span
span_b Span -> Span -> Bool
`containsSpan` Span
span_a = [HieAST Type] -> [HieAST Type] -> [HieAST Type]
mergeAsts [HieAST Type]
as (HieAST Type -> HieAST Type -> HieAST Type
combineAst HieAST Type
a HieAST Type
b HieAST Type -> [HieAST Type] -> [HieAST Type]
forall a. a -> [a] -> [a]
: [HieAST Type]
bs)
| Span
span_a Span -> Span -> Bool
`rightOf` Span
span_b = HieAST Type
b HieAST Type -> [HieAST Type] -> [HieAST Type]
forall a. a -> [a] -> [a]
: [HieAST Type] -> [HieAST Type] -> [HieAST Type]
mergeAsts [HieAST Type]
xs [HieAST Type]
bs
| Span
span_a Span -> Span -> Bool
`leftOf` Span
span_b = HieAST Type
a HieAST Type -> [HieAST Type] -> [HieAST Type]
forall a. a -> [a] -> [a]
: [HieAST Type] -> [HieAST Type] -> [HieAST Type]
mergeAsts [HieAST Type]
as [HieAST Type]
ys
| Span
span_a Span -> Span -> Bool
`startsRightOf` Span
span_b = HieAST Type
b HieAST Type -> [HieAST Type] -> [HieAST Type]
forall a. a -> [a] -> [a]
: [HieAST Type] -> [HieAST Type] -> [HieAST Type]
mergeAsts [HieAST Type]
as [HieAST Type]
ys
| Bool
otherwise = HieAST Type
a HieAST Type -> [HieAST Type] -> [HieAST Type]
forall a. a -> [a] -> [a]
: [HieAST Type] -> [HieAST Type] -> [HieAST Type]
mergeAsts [HieAST Type]
as [HieAST Type]
ys
where
span_a :: Span
span_a = HieAST Type -> Span
forall a. HieAST a -> Span
nodeSpan HieAST Type
a
span_b :: Span
span_b = HieAST Type -> Span
forall a. HieAST a -> Span
nodeSpan HieAST Type
b
rightOf :: Span -> Span -> Bool
rightOf :: Span -> Span -> Bool
rightOf Span
s1 Span
s2
= (Span -> Int
srcSpanStartLine Span
s1, Span -> Int
srcSpanStartCol Span
s1)
(Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Span -> Int
srcSpanEndLine Span
s2, Span -> Int
srcSpanEndCol Span
s2)
Bool -> Bool -> Bool
&& (Span -> FastString
srcSpanFile Span
s1 FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== Span -> FastString
srcSpanFile Span
s2)
leftOf :: Span -> Span -> Bool
leftOf :: Span -> Span -> Bool
leftOf Span
s1 Span
s2
= (Span -> Int
srcSpanEndLine Span
s1, Span -> Int
srcSpanEndCol Span
s1)
(Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
<= (Span -> Int
srcSpanStartLine Span
s2, Span -> Int
srcSpanStartCol Span
s2)
Bool -> Bool -> Bool
&& (Span -> FastString
srcSpanFile Span
s1 FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== Span -> FastString
srcSpanFile Span
s2)
startsRightOf :: Span -> Span -> Bool
startsRightOf :: Span -> Span -> Bool
startsRightOf Span
s1 Span
s2
= (Span -> Int
srcSpanStartLine Span
s1, Span -> Int
srcSpanStartCol Span
s1)
(Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Span -> Int
srcSpanStartLine Span
s2, Span -> Int
srcSpanStartCol Span
s2)
mergeSortAsts :: [HieAST Type] -> [HieAST Type]
mergeSortAsts :: [HieAST Type] -> [HieAST Type]
mergeSortAsts = [[HieAST Type]] -> [HieAST Type]
go ([[HieAST Type]] -> [HieAST Type])
-> ([HieAST Type] -> [[HieAST Type]])
-> [HieAST Type]
-> [HieAST Type]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HieAST Type -> [HieAST Type]) -> [HieAST Type] -> [[HieAST Type]]
forall a b. (a -> b) -> [a] -> [b]
map HieAST Type -> [HieAST Type]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
where
go :: [[HieAST Type]] -> [HieAST Type]
go [] = []
go [[HieAST Type]
xs] = [HieAST Type]
xs
go [[HieAST Type]]
xss = [[HieAST Type]] -> [HieAST Type]
go ([[HieAST Type]] -> [[HieAST Type]]
mergePairs [[HieAST Type]]
xss)
mergePairs :: [[HieAST Type]] -> [[HieAST Type]]
mergePairs [] = []
mergePairs [[HieAST Type]
xs] = [[HieAST Type]
xs]
mergePairs ([HieAST Type]
xs:[HieAST Type]
ys:[[HieAST Type]]
xss) = [HieAST Type] -> [HieAST Type] -> [HieAST Type]
mergeAsts [HieAST Type]
xs [HieAST Type]
ys [HieAST Type] -> [[HieAST Type]] -> [[HieAST Type]]
forall a. a -> [a] -> [a]
: [[HieAST Type]] -> [[HieAST Type]]
mergePairs [[HieAST Type]]
xss
simpleNodeInfo :: FastString -> FastString -> NodeInfo a
simpleNodeInfo :: forall a. FastString -> FastString -> NodeInfo a
simpleNodeInfo FastString
cons FastString
typ = Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
forall a.
Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
NodeInfo (NodeAnnotation -> Set NodeAnnotation
forall a. a -> Set a
S.singleton (FastString -> FastString -> NodeAnnotation
NodeAnnotation FastString
cons FastString
typ)) [] NodeIdentifiers a
forall k a. Map k a
M.empty
locOnly :: Monad m => SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly :: forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly (RealSrcSpan Span
span Maybe BufSpan
_) = do
NodeOrigin
org <- ReaderT NodeOrigin m NodeOrigin
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let e :: SourcedNodeInfo a
e = NodeOrigin -> NodeInfo a -> SourcedNodeInfo a
forall a. NodeOrigin -> NodeInfo a -> SourcedNodeInfo a
mkSourcedNodeInfo NodeOrigin
org (NodeInfo a -> SourcedNodeInfo a)
-> NodeInfo a -> SourcedNodeInfo a
forall a b. (a -> b) -> a -> b
$ NodeInfo a
forall a. NodeInfo a
emptyNodeInfo
[HieAST a] -> ReaderT NodeOrigin m [HieAST a]
forall a. a -> ReaderT NodeOrigin m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
forall a. SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
Node SourcedNodeInfo a
e Span
span []]
locOnly SrcSpan
_ = [HieAST a] -> ReaderT NodeOrigin m [HieAST a]
forall a. a -> ReaderT NodeOrigin m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
mkScopeA :: SrcSpanAnn' ann -> Scope
mkScopeA :: forall ann. SrcSpanAnn' ann -> Scope
mkScopeA SrcSpanAnn' ann
l = SrcSpan -> Scope
mkScope (SrcSpanAnn' ann -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' ann
l)
mkScope :: SrcSpan -> Scope
mkScope :: SrcSpan -> Scope
mkScope (RealSrcSpan Span
sp Maybe BufSpan
_) = Span -> Scope
LocalScope Span
sp
mkScope SrcSpan
_ = Scope
NoScope
mkLScope :: Located a -> Scope
mkLScope :: forall a. Located a -> Scope
mkLScope = SrcSpan -> Scope
mkScope (SrcSpan -> Scope) -> (Located a -> SrcSpan) -> Located a -> Scope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located a -> SrcSpan
forall l e. GenLocated l e -> l
getLoc
mkLScopeA :: GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA :: forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA = SrcSpan -> Scope
mkScope (SrcSpan -> Scope)
-> (GenLocated (SrcSpanAnn' a) e -> SrcSpan)
-> GenLocated (SrcSpanAnn' a) e
-> Scope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA (SrcSpanAnn' a -> SrcSpan)
-> (GenLocated (SrcSpanAnn' a) e -> SrcSpanAnn' a)
-> GenLocated (SrcSpanAnn' a) e
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcSpanAnn' a) e -> SrcSpanAnn' a
forall l e. GenLocated l e -> l
getLoc
mkLScopeN :: LocatedN a -> Scope
mkLScopeN :: forall a. LocatedN a -> Scope
mkLScopeN = SrcSpan -> Scope
mkScope (SrcSpan -> Scope)
-> (LocatedN a -> SrcSpan) -> LocatedN a -> Scope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedN a -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA
combineScopes :: Scope -> Scope -> Scope
combineScopes :: Scope -> Scope -> Scope
combineScopes Scope
ModuleScope Scope
_ = Scope
ModuleScope
combineScopes Scope
_ Scope
ModuleScope = Scope
ModuleScope
combineScopes Scope
NoScope Scope
x = Scope
x
combineScopes Scope
x Scope
NoScope = Scope
x
combineScopes (LocalScope Span
a) (LocalScope Span
b) =
SrcSpan -> Scope
mkScope (SrcSpan -> Scope) -> SrcSpan -> Scope
forall a b. (a -> b) -> a -> b
$ SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (Span -> Maybe BufSpan -> SrcSpan
RealSrcSpan Span
a Maybe BufSpan
forall a. Maybe a
Strict.Nothing) (Span -> Maybe BufSpan -> SrcSpan
RealSrcSpan Span
b Maybe BufSpan
forall a. Maybe a
Strict.Nothing)
mkSourcedNodeInfo :: NodeOrigin -> NodeInfo a -> SourcedNodeInfo a
mkSourcedNodeInfo :: forall a. NodeOrigin -> NodeInfo a -> SourcedNodeInfo a
mkSourcedNodeInfo NodeOrigin
org NodeInfo a
ni = Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
forall a. Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
SourcedNodeInfo (Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a)
-> Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
forall a b. (a -> b) -> a -> b
$ NodeOrigin -> NodeInfo a -> Map NodeOrigin (NodeInfo a)
forall k a. k -> a -> Map k a
M.singleton NodeOrigin
org NodeInfo a
ni
{-# INLINEABLE makeNodeA #-}
makeNodeA
:: (Monad m, Data a)
=> a
-> SrcSpanAnn' ann
-> ReaderT NodeOrigin m [HieAST b]
makeNodeA :: forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA a
x SrcSpanAnn' ann
spn = a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
forall (m :: * -> *) a b.
(Monad m, Data a) =>
a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
makeNode a
x (SrcSpanAnn' ann -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' ann
spn)
{-# INLINEABLE makeNode #-}
makeNode
:: (Monad m, Data a)
=> a
-> SrcSpan
-> ReaderT NodeOrigin m [HieAST b]
makeNode :: forall (m :: * -> *) a b.
(Monad m, Data a) =>
a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
makeNode a
x SrcSpan
spn = do
NodeOrigin
org <- ReaderT NodeOrigin m NodeOrigin
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
[HieAST b] -> ReaderT NodeOrigin m [HieAST b]
forall a. a -> ReaderT NodeOrigin m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([HieAST b] -> ReaderT NodeOrigin m [HieAST b])
-> [HieAST b] -> ReaderT NodeOrigin m [HieAST b]
forall a b. (a -> b) -> a -> b
$ case SrcSpan
spn of
RealSrcSpan Span
span Maybe BufSpan
_ -> [SourcedNodeInfo b -> Span -> [HieAST b] -> HieAST b
forall a. SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
Node (NodeOrigin -> NodeInfo b -> SourcedNodeInfo b
forall a. NodeOrigin -> NodeInfo a -> SourcedNodeInfo a
mkSourcedNodeInfo NodeOrigin
org (NodeInfo b -> SourcedNodeInfo b)
-> NodeInfo b -> SourcedNodeInfo b
forall a b. (a -> b) -> a -> b
$ FastString -> FastString -> NodeInfo b
forall a. FastString -> FastString -> NodeInfo a
simpleNodeInfo FastString
cons FastString
typ) Span
span []]
SrcSpan
_ -> []
where
cons :: FastString
cons = String -> FastString
mkFastString (String -> FastString) -> (a -> String) -> a -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> String
forall a. Show a => a -> String
show (Constr -> String) -> (a -> Constr) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Constr
forall a. Data a => a -> Constr
toConstr (a -> FastString) -> a -> FastString
forall a b. (a -> b) -> a -> b
$ a
x
typ :: FastString
typ = String -> FastString
mkFastString (String -> FastString) -> (a -> String) -> a -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> String
forall a. Show a => a -> String
show (TyCon -> String) -> (a -> TyCon) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> TyCon
typeRepTyCon (TypeRep -> TyCon) -> (a -> TypeRep) -> a -> TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (a -> FastString) -> a -> FastString
forall a b. (a -> b) -> a -> b
$ a
x
{-# INLINEABLE makeTypeNodeA #-}
makeTypeNodeA
:: (Monad m, Data a)
=> a
-> SrcSpanAnnA
-> Type
-> ReaderT NodeOrigin m [HieAST Type]
makeTypeNodeA :: forall (m :: * -> *) a.
(Monad m, Data a) =>
a -> SrcSpanAnnA -> Type -> ReaderT NodeOrigin m [HieAST Type]
makeTypeNodeA a
x SrcSpanAnnA
spn Type
etyp = a -> SrcSpan -> Type -> ReaderT NodeOrigin m [HieAST Type]
forall (m :: * -> *) a.
(Monad m, Data a) =>
a -> SrcSpan -> Type -> ReaderT NodeOrigin m [HieAST Type]
makeTypeNode a
x (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
spn) Type
etyp
{-# INLINEABLE makeTypeNode #-}
makeTypeNode
:: (Monad m, Data a)
=> a
-> SrcSpan
-> Type
-> ReaderT NodeOrigin m [HieAST Type]
makeTypeNode :: forall (m :: * -> *) a.
(Monad m, Data a) =>
a -> SrcSpan -> Type -> ReaderT NodeOrigin m [HieAST Type]
makeTypeNode a
x SrcSpan
spn Type
etyp = do
NodeOrigin
org <- ReaderT NodeOrigin m NodeOrigin
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
[HieAST Type] -> ReaderT NodeOrigin m [HieAST Type]
forall a. a -> ReaderT NodeOrigin m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([HieAST Type] -> ReaderT NodeOrigin m [HieAST Type])
-> [HieAST Type] -> ReaderT NodeOrigin m [HieAST Type]
forall a b. (a -> b) -> a -> b
$ case SrcSpan
spn of
RealSrcSpan Span
span Maybe BufSpan
_ ->
[SourcedNodeInfo Type -> Span -> [HieAST Type] -> HieAST Type
forall a. SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
Node (NodeOrigin -> NodeInfo Type -> SourcedNodeInfo Type
forall a. NodeOrigin -> NodeInfo a -> SourcedNodeInfo a
mkSourcedNodeInfo NodeOrigin
org (NodeInfo Type -> SourcedNodeInfo Type)
-> NodeInfo Type -> SourcedNodeInfo Type
forall a b. (a -> b) -> a -> b
$ Set NodeAnnotation
-> [Type] -> NodeIdentifiers Type -> NodeInfo Type
forall a.
Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
NodeInfo (NodeAnnotation -> Set NodeAnnotation
forall a. a -> Set a
S.singleton (FastString -> FastString -> NodeAnnotation
NodeAnnotation FastString
cons FastString
typ)) [Type
etyp] NodeIdentifiers Type
forall k a. Map k a
M.empty) Span
span []]
SrcSpan
_ -> []
where
cons :: FastString
cons = String -> FastString
mkFastString (String -> FastString) -> (a -> String) -> a -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> String
forall a. Show a => a -> String
show (Constr -> String) -> (a -> Constr) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Constr
forall a. Data a => a -> Constr
toConstr (a -> FastString) -> a -> FastString
forall a b. (a -> b) -> a -> b
$ a
x
typ :: FastString
typ = String -> FastString
mkFastString (String -> FastString) -> (a -> String) -> a -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> String
forall a. Show a => a -> String
show (TyCon -> String) -> (a -> TyCon) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> TyCon
typeRepTyCon (TypeRep -> TyCon) -> (a -> TypeRep) -> a -> TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (a -> FastString) -> a -> FastString
forall a b. (a -> b) -> a -> b
$ a
x