module Scion.Inspect.TypeOf where
import Scion.Inspect.Find ( SearchResult(..) )
import GHC
import Var ( varType )
import TypeRep ( Type(..), PredType(..) )
typeOf :: (SearchResult Id, [SearchResult Id]) -> Maybe Type
typeOf (leaf, path) = case leaf of
FoundId i -> type_of_id i
_ -> Nothing
where
type_of_id i = case path of
FoundExpr _ (HsVar _) : FoundExpr _ (HsWrap wr _) : _ ->
Just $ reduce_type $ unwrap wr (varType i)
_ -> Just (varType i)
unwrap WpHole t = t
unwrap (WpCompose w1 w2) t = unwrap w1 (unwrap w2 t)
unwrap (WpCast _) t = t
unwrap (WpTyApp t') t = AppTy t t'
unwrap (WpTyLam tv) t = ForAllTy tv t
unwrap (WpApp v) t = AppTy t (TyVarTy v)
unwrap (WpLam v) t = ForAllTy v t
unwrap (WpLet _bs) t = t
#ifdef WPINLINE
unwrap WpInline t = t
#endif
reduce_type :: Type -> Type
reduce_type (AppTy (ForAllTy tv b) t) =
reduce_type (subst_type tv t b)
reduce_type t = t
subst_type :: TyVar -> Type -> Type -> Type
subst_type v t' t0 = go t0
where
go t = case t of
TyVarTy tv
| tv == v -> t'
| otherwise -> t
AppTy t1 t2 -> AppTy (go t1) (go t2)
TyConApp c ts -> TyConApp c (map go ts)
FunTy t1 t2 -> FunTy (go t1) (go t2)
ForAllTy v' bt
| v == v' -> t
| otherwise -> ForAllTy v' (go bt)
PredTy pt -> PredTy (go_pt pt)
go_pt (ClassP c ts) = ClassP c (map go ts)
go_pt (IParam i t) = IParam i (go t)
go_pt (EqPred t1 t2) = EqPred (go t1) (go t2)