aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/HaskellCodeExplorer/AST/TypecheckedSource.hs652
1 files changed, 224 insertions, 428 deletions
diff --git a/src/HaskellCodeExplorer/AST/TypecheckedSource.hs b/src/HaskellCodeExplorer/AST/TypecheckedSource.hs
index 7cf5157..cb7d323 100644
--- a/src/HaskellCodeExplorer/AST/TypecheckedSource.hs
+++ b/src/HaskellCodeExplorer/AST/TypecheckedSource.hs
@@ -21,23 +21,23 @@ module HaskellCodeExplorer.AST.TypecheckedSource
import GHC.Data.Bag (bagToList)
import GHC.Types.Basic (Origin(..))
import GHC.Core.Class (Class, classTyVars)
-import GHC.Core.ConLike (ConLike(..)
--- , conLikeWrapId_maybe
- )
-import Control.Monad (return, unless, void)
+import Control.Monad (unless, void, when)
import Control.Monad.State.Strict (State, get, modify')
+import Data.Either (isLeft, fromLeft)
import qualified Data.HashMap.Strict as HM
import qualified Data.IntMap.Strict as IM
import qualified Data.IntervalMap.Strict as IVM
import qualified Data.Map.Strict as M
-import Data.Maybe (Maybe, fromMaybe, mapMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.Set as S
import qualified Data.Text as T
-import GHC.Core.DataCon (dataConWorkId)
+import GHC.Core.Multiplicity (scaledThing)
import GHC
( DynFlags
, TyThing(..)
- , CoPat(..)
+ , getLocA
+ , reLocA
+ , reLocN
)
import GHC.Data.FastString (mkFastString)
import GHC.Unit.State (UnitState)
@@ -118,6 +118,7 @@ import GHC.Types.SrcLoc
( GenLocated(..)
, SrcSpan(..)
, isGoodSrcSpan
+ , UnhelpfulSpanReason(..)
, isOneLineSpan
, unLoc
-- #if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)
@@ -136,9 +137,10 @@ import GHC.Core.Type
#endif
, eqTypes
, eqType
- , mkFunTy
--- , mkFunTys
--- , splitForAllTys
+ , mkVisFunTys
+ , mkVisFunTyMany
+ , mkVisFunTysMany
+ , splitForAllTyCoVars
, splitFunTy_maybe
, splitFunTys
, substTys
@@ -248,7 +250,7 @@ splitFunTySafe ::
SrcSpan -> T.Text -> Type -> State ASTState (Maybe (Type, Type))
splitFunTySafe srcSpan astNode typ =
case splitFunTy_maybe typ of
- Just (ty1, ty2) -> return $ Just (ty1, ty2)
+ Just (_, ty1, ty2) -> return $ Just (ty1, ty2)
Nothing -> do
flags <- envDynFlags . astStateEnv <$> get
let typeError =
@@ -402,6 +404,7 @@ traceInstanceResolution ::
traceInstanceResolution environment c ts = go c ts S.empty
where
flags = envDynFlags environment
+ unitState = envUnitState environment
go :: Class -> [Type] -> S.Set (Name, InstTypes) -> HCE.InstanceResolution
go cls types seenInstances =
let clsTyVarCount = length $ classTyVars cls
@@ -425,7 +428,7 @@ traceInstanceResolution environment c ts = go c ts S.empty
(mkType flags . idType $ is_dfun inst)
(map (mkType flags) instTypes)
(nameLocationInfo
- flags
+ unitState
(envPackageId environment)
(envComponentId environment)
(envTransformation environment)
@@ -555,12 +558,13 @@ restoreTidyEnv action = do
modify' $ \s -> s {astStateTidyEnv = tidyEnv}
return res
-restoreHsWrapper :: (State ASTState) a -> (State ASTState) a
-restoreHsWrapper action = do
- wrapper <- astStateHsWrapper <$> get
- res <- action
- modify' $ \s -> s {astStateHsWrapper = wrapper}
- return res
+-- not used any more
+-- restoreHsWrapper :: (State ASTState) a -> (State ASTState) a
+-- restoreHsWrapper action = do
+-- wrapper <- astStateHsWrapper <$> get
+-- res <- action
+-- modify' $ \s -> s {astStateHsWrapper = wrapper}
+-- return res
tidyIdentifier :: Id -> State ASTState (Id, Maybe (Type, [Type]))
tidyIdentifier identifier = do
@@ -601,19 +605,15 @@ foldLHsExpr :: LHsExpr GhcTc -> State ASTState (Maybe Type)
#else
foldLHsExpr :: LHsExpr Id -> State ASTState (Maybe Type)
#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
foldLHsExpr (L _span (XExpr _)) = return Nothing
foldLHsExpr (L _ (HsOverLit _ (XOverLit _))) = return Nothing
foldLHsExpr (L _ (HsLam _ (XMatchGroup _))) = return Nothing
foldLHsExpr (L _ (HsLamCase _ (XMatchGroup _))) = return Nothing
foldLHsExpr (L _ (HsCase _ _ (XMatchGroup _))) = return Nothing
-foldLHsExpr (L span (HsVar _ (L _ identifier))) =
-#else
-foldLHsExpr (L span (HsVar (L _ identifier))) =
-#endif
+foldLHsExpr lhe@(L _ (HsVar _ (L _ identifier))) =
restoreTidyEnv $ do
(identifier', mbTypes) <- tidyIdentifier identifier
- addIdentifierToIdSrcSpanMap span identifier' mbTypes
+ addIdentifierToIdSrcSpanMap (getLocA lhe) identifier' mbTypes
return . Just . varType $ identifier'
foldLHsExpr (L _ HsUnboundVar {}) = return Nothing
#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
@@ -630,151 +630,100 @@ foldLHsExpr (L _ (HsConLikeOut conLike)) =
#endif
foldLHsExpr (L _ HsRecFld {}) = return Nothing
foldLHsExpr (L _ HsOverLabel {}) = return Nothing
-foldLHsExpr (L span expr@HsIPVar {}) = do
- addExprInfo span Nothing "HsIPVar" (exprSort expr)
+foldLHsExpr lhe@(L _ expr@HsIPVar {}) = do
+ addExprInfo (getLocA lhe) Nothing "HsIPVar" (exprSort expr)
return Nothing
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span (HsOverLit _ (OverLit (OverLitTc _ ol_type) _ _))) =
-#else
-foldLHsExpr (L span (HsOverLit OverLit {ol_type})) =
-#endif
+foldLHsExpr lhe@(L _ (HsOverLit _ (OverLit (OverLitTc _ ol_type) _ _))) =
restoreTidyEnv $ do
typ <- tidyType ol_type
addExprInfo
- span
+ (getLocA lhe)
(Just typ)
"HsOverLit"
- (if isOneLineSpan span
+ (if isOneLineSpan (getLocA lhe)
then Simple
else Composite)
return $ Just typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span (HsLit _ lit)) =
-#else
-foldLHsExpr (L span (HsLit lit)) =
-#endif
+foldLHsExpr lhe@(L _ (HsLit _ lit)) =
restoreTidyEnv $ do
typ <- tidyType $ hsLitType lit
addExprInfo
- span
+ (getLocA lhe)
(Just typ)
"HsLit"
- (if isOneLineSpan span
+ (if isOneLineSpan (getLocA lhe)
then Simple
else Composite)
return $ Just typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span expr@(HsLam _ (MG (MatchGroupTc {..}) mg_alts _))) =
-#else
-foldLHsExpr (L span expr@(HsLam MG {..})) =
-#endif
+foldLHsExpr lhe@(L span expr@(HsLam _ (MG (MatchGroupTc {..}) mg_alts _))) =
restoreTidyEnv $ do
- typ <- tidyType $ mkFunTys mg_arg_tys mg_res_ty
- addExprInfo span (Just typ) "HsLam" (exprSort expr)
+ typ <- tidyType $ mkVisFunTys mg_arg_tys mg_res_ty
+ addExprInfo (getLocA lhe) (Just typ) "HsLam" (exprSort expr)
mapM_ foldLMatch $ unLoc mg_alts
return $ Just typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span expr@(HsLamCase _ (MG (MatchGroupTc {..}) mg_alts _))) =
-#else
-foldLHsExpr (L span expr@(HsLamCase MG {..})) =
-#endif
-#else
-foldLHsExpr (L span expr@(HsLamCase _typ MG {..})) =
-#endif
+foldLHsExpr lhe@(L _ expr@(HsLamCase _ (MG (MatchGroupTc {..}) mg_alts _))) =
restoreTidyEnv $ do
- typ <- tidyType $ mkFunTys mg_arg_tys mg_res_ty
- addExprInfo span (Just typ) "HsLamCase" (exprSort expr)
+ typ <- tidyType $ mkVisFunTys mg_arg_tys mg_res_ty
+ addExprInfo (getLocA lhe) (Just typ) "HsLamCase" (exprSort expr)
mapM_ foldLMatch $ unLoc mg_alts
return $ Just typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span expr@(HsApp _ fun arg)) = do
-#else
-foldLHsExpr (L span expr@(HsApp fun arg)) = do
-#endif
+foldLHsExpr lhe@(L _ expr@(HsApp _ fun arg)) = do
funTy <- foldLHsExpr fun
_argTy <- foldLHsExpr arg
- typ <- maybe (return Nothing) (funResultTySafe span "HsApp") funTy
- addExprInfo span typ "HsApp" (exprSort expr)
+ typ <- maybe (return Nothing) (funResultTySafe (getLocA lhe) "HsApp") funTy
+ addExprInfo (getLocA lhe) typ "HsApp" (exprSort expr)
return typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)
-foldLHsExpr (L span ex@(HsAppType _ expr _)) = do
-#elif MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span ex@(HsAppType _ expr)) = do
-#else
-foldLHsExpr (L _ (HsAppType _ _)) = return Nothing
-foldLHsExpr (L span ex@(HsAppTypeOut expr _)) = do
-#endif
+foldLHsExpr lhe@(L _ ex@(HsAppType _ expr _)) = do
typ <- foldLHsExpr expr
- addExprInfo span typ "HsAppType" (exprSort ex)
+ addExprInfo (getLocA lhe) typ "HsAppType" (exprSort ex)
return typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span expr@(OpApp _ left op right)) = do
-#else
-foldLHsExpr (L span expr@(OpApp left op _fixity right)) = do
-#endif
+foldLHsExpr lhe@(L _ expr@(OpApp _ left op right)) = do
opTyp <- foldLHsExpr op
- typ <- maybe (return Nothing) (funResultTy2Safe span "HsApp") opTyp
+ typ <- maybe (return Nothing) (funResultTy2Safe (getLocA lhe) "HsApp") opTyp
_ <- foldLHsExpr left
_ <- foldLHsExpr right
- addExprInfo span typ "OpApp" (exprSort expr)
+ addExprInfo (getLocA lhe) typ "OpApp" (exprSort expr)
return typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span e@(NegApp _ expr _syntaxExp)) = do
-#else
-foldLHsExpr (L span e@(NegApp expr _syntaxExp)) = do
-#endif
+foldLHsExpr lhe@(L _ e@(NegApp _ expr _syntaxExp)) = do
typ <- foldLHsExpr expr
- addExprInfo span typ "NegApp" (exprSort e)
+ addExprInfo (getLocA lhe) typ "NegApp" (exprSort e)
return typ
#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
foldLHsExpr (L _span (HsPar _ expr)) = foldLHsExpr expr
#else
foldLHsExpr (L _span (HsPar expr)) = foldLHsExpr expr
#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span expr@(SectionL _ operand operator)) = do
-#else
-foldLHsExpr (L span expr@(SectionL operand operator)) = do
-#endif
+foldLHsExpr lhe@(L _ expr@(SectionL _ operand operator)) = do
opType <- foldLHsExpr operator
_ <- foldLHsExpr operand
- mbTypes <- maybe (return Nothing) (splitFunTy2Safe span "SectionL") opType
+ mbTypes <- maybe (return Nothing) (splitFunTy2Safe (getLocA lhe) "SectionL") opType
let typ =
case mbTypes of
- Just (_arg1, arg2, res) -> Just $ mkFunTy arg2 res
+ Just (_arg1, arg2, res) -> Just $ mkVisFunTyMany arg2 res
Nothing -> Nothing
- addExprInfo span typ "SectionL" (exprSort expr)
+ addExprInfo (getLocA lhe) typ "SectionL" (exprSort expr)
return typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span e@(SectionR _ operator operand)) = do
-#else
-foldLHsExpr (L span e@(SectionR operator operand)) = do
-#endif
+foldLHsExpr lhe@(L _ e@(SectionR _ operator operand)) = do
opType <- foldLHsExpr operator
_ <- foldLHsExpr operand
- mbTypes <- maybe (return Nothing) (splitFunTy2Safe span "SectionR") opType
+ mbTypes <- maybe (return Nothing) (splitFunTy2Safe (getLocA lhe) "SectionR") opType
let typ =
case mbTypes of
- Just (arg1, _arg2, res) -> Just $ mkFunTy arg1 res
+ Just (arg1, _arg2, res) -> Just $ mkVisFunTyMany arg1 res
Nothing -> Nothing
- addExprInfo span typ "SectionR" (exprSort e)
+ addExprInfo (getLocA lhe) typ "SectionR" (exprSort e)
return typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span e@(ExplicitTuple _ tupArgs boxity)) = do
-#else
-foldLHsExpr (L span e@(ExplicitTuple tupArgs boxity)) = do
-#endif
- tupleArgs <- mapM foldLHsTupArg tupArgs
+foldLHsExpr lhe@(L _ e@(ExplicitTuple _ tupArgs boxity)) = do
+ tupleArgs <- mapM foldHsTupArg tupArgs
let tupleSectionArgTys =
mapM fst . filter ((== TupArgMissing) . snd) $ tupleArgs
tupleArgTys = mapM fst tupleArgs
resultType =
- mkFunTys <$> tupleSectionArgTys <*> (mkTupleTy boxity <$> tupleArgTys)
+ mkVisFunTysMany <$> tupleSectionArgTys <*> (mkTupleTy boxity <$> tupleArgTys)
tidyEnv <- astStateTidyEnv <$> get
addExprInfo
- span
+ (getLocA lhe)
(snd . tidyOpenType tidyEnv <$> resultType)
"ExplicitTuple"
(exprSort e)
@@ -789,106 +738,70 @@ foldLHsExpr (L _span (ExplicitSum _ _ expr _types)) = do
_ <- foldLHsExpr expr
return Nothing
#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span e@(HsCase _ expr (MG (MatchGroupTc {..}) mg_alts _))) =
-#else
-foldLHsExpr (L span e@(HsCase expr MG {..})) =
-#endif
+foldLHsExpr lhe@(L _ e@(HsCase _ expr (MG (MatchGroupTc {..}) mg_alts _))) =
restoreTidyEnv $ do
typ <- tidyType mg_res_ty
_ <- foldLHsExpr expr
mapM_ foldLMatch (unLoc mg_alts)
- addExprInfo span (Just typ) "HsCase" (exprSort e)
+ addExprInfo (getLocA lhe) (Just typ) "HsCase" (exprSort e)
return $ Just typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span e@(HsIf _ _mbSynExpr condExpr thenExpr elseExpr)) = do
-#else
-foldLHsExpr (L span e@(HsIf _mbSynExpr condExpr thenExpr elseExpr)) = do
-#endif
+foldLHsExpr lhe@(L _ e@(HsIf _ condExpr thenExpr elseExpr)) = do
_ <- foldLHsExpr condExpr
typ <- foldLHsExpr thenExpr
_ <- foldLHsExpr elseExpr
- addExprInfo span typ "HsIf" (exprSort e)
+ addExprInfo (getLocA lhe) typ "HsIf" (exprSort e)
return typ
-foldLHsExpr (L span e@(HsMultiIf typ grhss)) =
+foldLHsExpr lhe@(L _ e@(HsMultiIf typ grhss)) =
restoreTidyEnv $ do
typ' <- tidyType typ
- addExprInfo span (Just typ') "HsMultiIf" (exprSort e)
+ addExprInfo (getLocA lhe) (Just typ') "HsMultiIf" (exprSort e)
mapM_ foldLGRHS grhss
return $ Just typ'
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span e@(HsLet _ (L _ binds) expr)) = do
-#else
-foldLHsExpr (L span e@(HsLet (L _ binds) expr)) = do
-#endif
+foldLHsExpr lhe@(L _ e@(HsLet _ binds expr)) = do
_ <- foldHsLocalBindsLR binds
typ <- foldLHsExpr expr
- addExprInfo span typ "HsLet" (exprSort e)
+ addExprInfo (getLocA lhe) typ "HsLet" (exprSort e)
return typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span expr@(HsDo typ _context (L _ stmts))) =
-#else
-foldLHsExpr (L span expr@(HsDo _context (L _ stmts) typ)) =
-#endif
+foldLHsExpr lhe@(L _ expr@(HsDo typ _context (L _ stmts))) =
restoreTidyEnv $ do
typ' <- tidyType typ
- addExprInfo span (Just typ') "HsDo" (exprSort expr)
+ addExprInfo (getLocA lhe) (Just typ') "HsDo" (exprSort expr)
mapM_ foldLStmtLR stmts
return $ Just typ'
-foldLHsExpr (L span (ExplicitList typ _syntaxExpr exprs)) =
+foldLHsExpr lhe@(L _ (ExplicitList typ exprs)) =
restoreTidyEnv $ do
typ' <- mkListTy <$> tidyType typ
- unless (null exprs) $ addExprInfo span (Just typ') "ExplicitList" Composite
- mapM_ foldLHsExpr exprs
- return $ Just typ'
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-#else
-foldLHsExpr (L span e@(ExplicitPArr typ exprs)) =
- restoreTidyEnv $ do
- typ' <- tidyType typ
- addExprInfo span (Just typ') "ExplicitPArr" (exprSort e)
+ unless (null exprs) $ addExprInfo (getLocA lhe) (Just typ') "ExplicitList" Composite
mapM_ foldLHsExpr exprs
return $ Just typ'
-#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span e@(RecordCon conExpr _ binds)) = do
-#else
-foldLHsExpr (L span e@(RecordCon (L _ _) _conLike conExpr binds)) = do
-#endif
+foldLHsExpr lhe@(L _ e@(RecordCon conExpr _ binds)) = do
mbConType <-
fmap (snd . splitFunTys) <$>
- foldLHsExpr (L (UnhelpfulSpan $ mkFastString "RecordCon") conExpr)
- addExprInfo span mbConType "RecordCon" (exprSort e)
+ foldLHsExpr
+ (reLocA
+ (L (UnhelpfulSpan $ UnhelpfulOther $ mkFastString "RecordCon") conExpr))
+ addExprInfo (getLocA lhe) mbConType "RecordCon" (exprSort e)
_ <- foldHsRecFields binds
return mbConType
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span e@(RecordUpd (RecordUpdTc cons _inputTys outTys _wrapper) expr binds)) =
-#else
-foldLHsExpr (L span e@(RecordUpd expr binds cons _inputTys outTys _wrapper)) =
-#endif
+foldLHsExpr lhe@(L _ e@(RecordUpd (RecordUpdTc cons _inputTys outTys _wrapper) expr binds)) =
restoreTidyEnv $ do
-- cons is a non-empty list of DataCons that have all the upd'd fields
let typ = conLikeResTy (head cons) outTys
typ' <- tidyType typ
- addExprInfo span (Just typ') "RecordUpd" (exprSort e)
+ addExprInfo (getLocA lhe) (Just typ') "RecordUpd" (exprSort e)
_ <- foldLHsExpr expr
- mapM_ foldLHsRecUpdField binds
+ when (isLeft binds) (mapM_ foldLHsRecUpdField (fromLeft [] binds))
return $ Just typ'
-#if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)
-foldLHsExpr (L span e@(ExprWithTySig _ expr _)) = do
-#elif MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span e@(ExprWithTySig _ expr)) = do
-#else
-foldLHsExpr (L _span (ExprWithTySig _expr _type)) = return Nothing
-foldLHsExpr (L span e@(ExprWithTySigOut expr _type)) = do
-#endif
+foldLHsExpr lhe@(L _ e@(ExprWithTySig _ expr _)) = do
typ <- foldLHsExpr expr
- addExprInfo span typ "ExprWithTySig" (exprSort e)
+ addExprInfo (getLocA lhe) typ "ExprWithTySig" (exprSort e)
return typ
-foldLHsExpr (L span e@(ArithSeq postTcExpr _mbSyntaxExpr seqInfo)) = do
+foldLHsExpr lhe@(L _ e@(ArithSeq postTcExpr _mbSyntaxExpr seqInfo)) = do
typ <-
- fmap (snd . splitFunTys . snd . splitForAllTys) <$>
- foldLHsExpr (L (UnhelpfulSpan $ mkFastString "ArithSeq") postTcExpr)
+ fmap (snd . splitFunTys . snd . splitForAllTyCoVars) <$>
+ foldLHsExpr
+ (reLocA
+ (L (UnhelpfulSpan $ UnhelpfulOther $ mkFastString "ArithSeq") postTcExpr))
_ <-
case seqInfo of
From expr -> foldLHsExpr expr
@@ -896,69 +809,46 @@ foldLHsExpr (L span e@(ArithSeq postTcExpr _mbSyntaxExpr seqInfo)) = do
FromTo expr1 expr2 -> foldLHsExpr expr1 >> foldLHsExpr expr2
FromThenTo expr1 expr2 expr3 ->
foldLHsExpr expr1 >> foldLHsExpr expr2 >> foldLHsExpr expr3
- addExprInfo span typ "ArithSeq" (exprSort e)
- return typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-#else
-foldLHsExpr (L span e@(PArrSeq postTcExpr _seqInfo)) = do
- typ <- foldLHsExpr (L (UnhelpfulSpan $ mkFastString "PArrSeq") postTcExpr)
- addExprInfo span typ "ArithSeq" (exprSort e)
+ addExprInfo (getLocA lhe) typ "ArithSeq" (exprSort e)
return typ
-#endif
-- #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
--- foldLHsExpr (L span e@(HsSCC _ _sourceText _fastString expr)) = do
+-- foldLHsExpr lhe@(L _ e@(HsSCC _ _sourceText _fastString expr)) = do
-- #else
--- foldLHsExpr (L span e@(HsSCC _sourceText _fastString expr)) = do
+-- foldLHsExpr lhe@(L _ e@(HsSCC _sourceText _fastString expr)) = do
-- #endif
-- typ <- foldLHsExpr expr
--- addExprInfo span typ "HsSCC" (exprSort e)
+-- addExprInfo (getLocA lhe) typ "HsSCC" (exprSort e)
-- return typ
-- #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
--- foldLHsExpr (L span e@(HsCoreAnn _ _sourceText _fastString expr)) = do
+-- foldLHsExpr lhe@(L _ e@(HsCoreAnn _ _sourceText _fastString expr)) = do
-- #else
--- foldLHsExpr (L span e@(HsCoreAnn _sourceText _fastString expr)) = do
+-- foldLHsExpr lhe@(L _ e@(HsCoreAnn _sourceText _fastString expr)) = do
-- #endif
-- typ <- foldLHsExpr expr
--- addExprInfo span typ "HsCoreAnn" (exprSort e)
+-- addExprInfo (getLocA lhe) typ "HsCoreAnn" (exprSort e)
-- return typ
foldLHsExpr (L _span HsBracket {}) = return Nothing
foldLHsExpr (L _span HsRnBracketOut {}) = return Nothing
foldLHsExpr (L _span HsTcBracketOut {}) = return Nothing
foldLHsExpr (L _span HsSpliceE {}) = return Nothing
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span expr@(HsProc _ pat cmd)) = do
-#else
-foldLHsExpr (L span expr@(HsProc pat cmd)) = do
-#endif
+foldLHsExpr lhe@(L _ expr@(HsProc _ pat cmd)) = do
_ <- foldLPat pat
_ <- foldLHsCmdTop cmd
- addExprInfo span Nothing "HsProc" (exprSort expr)
+ addExprInfo (getLocA lhe) Nothing "HsProc" (exprSort expr)
return Nothing
-#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
-foldLHsExpr (L span e@(HsStatic _ expr)) = do
-#else
-foldLHsExpr (L span e@(HsStatic expr)) = do
-#endif
+foldLHsExpr lhe@(L _ e@(HsStatic _ expr)) = do
typ <- foldLHsExpr expr
- addExprInfo span typ "HsStatic" (exprSort e)
+ addExprInfo (getLocA lhe) typ "HsStatic" (exprSort e)
return typ
-- foldLHsExpr (L _ HsArrForm {}) = return Nothing
-- foldLHsExpr (L _ HsArrApp {}) = return Nothing
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span e@(HsTick _ _ expr)) = do
-#else
-foldLHsExpr (L span e@(HsTick _ expr)) = do
-#endif
+foldLHsExpr lhe@(L _ e@(HsTick _ _ expr)) = do
typ <- foldLHsExpr expr
- addExprInfo span typ "HsTick" (exprSort e)
+ addExprInfo (getLocA lhe) typ "HsTick" (exprSort e)
return typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span e@(HsBinTick _ _ _ expr)) = do
-#else
-foldLHsExpr (L span e@(HsBinTick _ _ expr)) = do
-#endif
+foldLHsExpr lhe@(L _ e@(HsBinTick _ _ _ expr)) = do
typ <- foldLHsExpr expr
- addExprInfo span typ "HsBinTick" (exprSort e)
+ addExprInfo (getLocA lhe) typ "HsBinTick" (exprSort e)
return typ
-- #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-- foldLHsExpr (L span e@(HsTickPragma _ _ _ _ expr)) = do
@@ -988,15 +878,11 @@ foldLHsExpr (L span e@(HsBinTick _ _ expr)) = do
-- typ <- foldLHsExpr (L span expr)
-- return $ applyWrapper wrapper <$> typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldHsRecFields :: HsRecFields GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type)
-#else
-foldHsRecFields :: HsRecFields Id (LHsExpr Id) -> State ASTState (Maybe Type)
-#endif
foldHsRecFields HsRecFields {..} = do
let userWritten =
case rec_dotdot of
- Just i -> take i
+ Just i -> take $ unLoc i
Nothing -> id
mapM_ foldLHsRecField $ userWritten rec_flds
return Nothing
@@ -1006,25 +892,17 @@ foldLHsRecField :: LHsRecField GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Ty
#else
foldLHsRecField :: LHsRecField Id (LHsExpr Id) -> State ASTState (Maybe Type)
#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsRecField (L _span (HsRecField (L _idSpan (XFieldOcc _)) _ _)) = return Nothing
-foldLHsRecField (L span (HsRecField (L idSpan (FieldOcc identifier _)) arg pun)) =
-#else
-foldLHsRecField (L span (HsRecField (L idSpan (FieldOcc _ identifier)) arg pun)) =
-#endif
+foldLHsRecField (L _span (HsRecField _ (L _idSpan (XFieldOcc _)) _ _)) = return Nothing
+foldLHsRecField lhr@(L _ (HsRecField _ (L idSpan (FieldOcc identifier _)) arg pun)) =
restoreTidyEnv $ do
(identifier', mbTypes) <- tidyIdentifier identifier
addIdentifierToIdSrcSpanMap idSpan identifier' mbTypes
- addExprInfo span (Just . varType $ identifier') "HsRecField" Composite
+ addExprInfo (getLocA lhr) (Just . varType $ identifier') "HsRecField" Composite
unless pun $ void (foldLHsExpr arg)
return . Just . varType $ identifier'
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLHsRecUpdField :: LHsRecUpdField GhcTc -> State ASTState (Maybe Type)
-#else
-foldLHsRecUpdField :: LHsRecUpdField Id -> State ASTState (Maybe Type)
-#endif
-foldLHsRecUpdField (L span (HsRecField (L idSpan recField) arg pun)) =
+foldLHsRecUpdField lhr@(L _ (HsRecField _ (L idSpan recField) arg pun)) =
restoreTidyEnv $ do
let selectorId = selectorAmbiguousFieldOcc recField
(identifier', mbTypes) <- tidyIdentifier selectorId
@@ -1038,7 +916,7 @@ foldLHsRecUpdField (L span (HsRecField (L idSpan recField) arg pun)) =
_ -> selName
let identifier'' = setVarName identifier' originalName
addIdentifierToIdSrcSpanMap idSpan identifier'' mbTypes
- addExprInfo span (Just . varType $ identifier'') "HsRecUpdField" Composite
+ addExprInfo (getLocA lhr) (Just . varType $ identifier'') "HsRecUpdField" Composite
unless pun $ void (foldLHsExpr arg)
return . Just . varType $ identifier'
@@ -1047,17 +925,25 @@ data TupArg
| TupArgMissing
deriving (Show, Eq)
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+foldHsTupArg :: HsTupArg GhcTc -> State ASTState (Maybe Type, TupArg)
+foldHsTupArg (XTupArg _) = return (Nothing, TupArgMissing)
+foldHsTupArg (Present _ expr) =
+ restoreTidyEnv $ do
+ typ <- foldLHsExpr expr
+ typ' <-
+ case typ of
+ Just t -> Just <$> tidyType t
+ Nothing -> return Nothing
+ return (typ', TupArgPresent)
+foldHsTupArg (Missing typ) =
+ restoreTidyEnv $ do
+ typ' <- tidyType $ scaledThing typ
+ return (Just typ', TupArgMissing)
+
+-- TODO: use foldHsTupArg
foldLHsTupArg :: LHsTupArg GhcTc -> State ASTState (Maybe Type, TupArg)
-#else
-foldLHsTupArg :: LHsTupArg Id -> State ASTState (Maybe Type, TupArg)
-#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
foldLHsTupArg (L _span (XTupArg _)) = return (Nothing, TupArgMissing)
foldLHsTupArg (L _span (Present _ expr)) =
-#else
-foldLHsTupArg (L _span (Present expr)) =
-#endif
restoreTidyEnv $ do
typ <- foldLHsExpr expr
typ' <-
@@ -1067,7 +953,7 @@ foldLHsTupArg (L _span (Present expr)) =
return (typ', TupArgPresent)
foldLHsTupArg (L _ (Missing typ)) =
restoreTidyEnv $ do
- typ' <- tidyType typ
+ typ' <- tidyType $ scaledThing typ
return (Just typ', TupArgMissing)
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
@@ -1103,7 +989,7 @@ foldGRHSsCmd :: GRHSs Id (LHsCmd Id) -> State ASTState (Maybe Type)
#endif
foldGRHSsCmd GRHSs {..} = do
mapM_ foldLGRHSCmd grhssGRHSs
- _ <- foldHsLocalBindsLR (unLoc grhssLocalBinds)
+ _ <- foldHsLocalBindsLR grhssLocalBinds
return Nothing
#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
foldGRHSsCmd (_) = return Nothing
@@ -1116,7 +1002,7 @@ foldGRHSs :: GRHSs Id (LHsExpr Id) -> State ASTState (Maybe Type)
#endif
foldGRHSs GRHSs {..} = do
mapM_ foldLGRHS grhssGRHSs
- _ <- foldHsLocalBindsLR (unLoc grhssLocalBinds)
+ _ <- foldHsLocalBindsLR grhssLocalBinds
return Nothing
#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
foldGRHSs (_) = return Nothing
@@ -1127,33 +1013,25 @@ foldLStmtLR :: LStmtLR GhcTc GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type
#else
foldLStmtLR :: LStmtLR Id Id (LHsExpr Id) -> State ASTState (Maybe Type)
#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
foldLStmtLR (L _span (XStmtLR _)) = return Nothing
-foldLStmtLR (L span (LastStmt _ body _ _)) =
-#else
-foldLStmtLR (L span (LastStmt body _ _)) =
-#endif
+foldLStmtLR lst@(L _ (LastStmt _ body _ _)) =
do typ <- foldLHsExpr body
- addExprInfo span typ "LastStmt" Composite
+ addExprInfo (getLocA lst) typ "LastStmt" Composite
return typ
#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLStmtLR (L _span (BindStmt _ pat body _ _)) = do
+foldLStmtLR (L _span (BindStmt _ pat body)) = do
#else
foldLStmtLR (L _span (BindStmt pat body _ _ _)) = do
#endif
_ <- foldLPat pat
_ <- foldLHsExpr body
return Nothing
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLStmtLR (L span (BodyStmt _ body _ _)) = do
-#else
-foldLStmtLR (L span (BodyStmt body _ _ _)) = do
-#endif
+foldLStmtLR lst@(L _ (BodyStmt _ body _ _)) = do
mbTyp <- foldLHsExpr body
- addExprInfo span mbTyp "BodyStmt" Composite
+ addExprInfo (getLocA lst) mbTyp "BodyStmt" Composite
return mbTyp
#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLStmtLR (L _ (LetStmt _ (L _ binds))) = do
+foldLStmtLR (L _ (LetStmt _ binds)) = do
#else
foldLStmtLR (L _ (LetStmt (L _ binds))) = do
#endif
@@ -1172,17 +1050,13 @@ foldLStmtLR (L _ TransStmt {..}) = do
_ <- foldLHsExpr trS_using
return Nothing
foldLStmtLR (L _span RecStmt {..}) = do
- mapM_ foldLStmtLR recS_stmts
+ mapM_ foldLStmtLR (unLoc recS_stmts)
return Nothing
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLStmtLR (L span (ApplicativeStmt typ args _)) =
-#else
-foldLStmtLR (L span (ApplicativeStmt args _ typ)) =
-#endif
+foldLStmtLR lslr@(L _ (ApplicativeStmt typ args _)) =
restoreTidyEnv $ do
typ' <- tidyType typ
mapM_ (foldApplicativeArg . snd) args
- addExprInfo span (Just typ') "ApplicativeStmt" Composite
+ addExprInfo (getLocA lslr) (Just typ') "ApplicativeStmt" Composite
return Nothing
#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
@@ -1208,7 +1082,7 @@ foldApplicativeArg appArg =
_ <- foldLHsExpr expr
return Nothing
#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
- ApplicativeArgMany _ exprStmts _ pat -> do
+ ApplicativeArgMany _ exprStmts _ pat _ -> do
#else
ApplicativeArgMany exprStmts _ pat -> do
#endif
@@ -1221,36 +1095,20 @@ foldLStmtLRCmd ::
#else
foldLStmtLRCmd :: LStmtLR Id Id (LHsCmd Id) -> State ASTState (Maybe Type)
#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
foldLStmtLRCmd (L _ (XStmtLR _)) = return Nothing
-foldLStmtLRCmd (L span (LastStmt _ body _syntaxExpr _)) = do
-#else
-foldLStmtLRCmd (L span (LastStmt body _syntaxExpr _)) = do
-#endif
+foldLStmtLRCmd ls@(L _ (LastStmt _ body _syntaxExpr _)) = do
typ <- foldLHsCmd body
- addExprInfo span typ "LastStmt Cmd" Composite
+ addExprInfo (getLocA ls) typ "LastStmt Cmd" Composite
return typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLStmtLRCmd (L _ (BindStmt _ pat body _ _)) = do
-#else
-foldLStmtLRCmd (L _ (BindStmt pat body _ _ _)) = do
-#endif
+foldLStmtLRCmd (L _ (BindStmt _ pat body)) = do
_ <- foldLPat pat
_ <- foldLHsCmd body
return Nothing
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLStmtLRCmd (L span (BodyStmt _ body _ _)) = do
-#else
-foldLStmtLRCmd (L span (BodyStmt body _ _ _)) = do
-#endif
+foldLStmtLRCmd ls@(L _ (BodyStmt _ body _ _)) = do
typ <- foldLHsCmd body
- addExprInfo span typ "BodyStmt Cmd" Composite
+ addExprInfo (getLocA ls) typ "BodyStmt Cmd" Composite
return typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLStmtLRCmd (L _ (LetStmt _ (L _ binds))) = do
-#else
-foldLStmtLRCmd (L _ (LetStmt (L _ binds))) = do
-#endif
+foldLStmtLRCmd (L _ (LetStmt _ binds)) = do
_ <- foldHsLocalBindsLR binds
return Nothing
#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
@@ -1266,17 +1124,13 @@ foldLStmtLRCmd (L _ TransStmt {..}) = do
_ <- maybe (return Nothing) foldLHsExpr trS_by
return Nothing
foldLStmtLRCmd (L _ RecStmt {..}) = do
- mapM_ foldLStmtLRCmd recS_stmts
+ mapM_ foldLStmtLRCmd (unLoc recS_stmts)
return Nothing
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLStmtLRCmd (L span (ApplicativeStmt typ args _)) =
-#else
-foldLStmtLRCmd (L span (ApplicativeStmt args _ typ)) =
-#endif
+foldLStmtLRCmd ls@(L _ (ApplicativeStmt typ args _)) =
restoreTidyEnv $ do
typ' <- tidyType typ
mapM_ (foldApplicativeArg . snd) args
- addExprInfo span (Just typ') "ApplicativeStmt Cmd" Composite
+ addExprInfo (getLocA ls) (Just typ') "ApplicativeStmt Cmd" Composite
return Nothing
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
@@ -1365,23 +1219,16 @@ foldLHsBindsLR :: LHsBinds Id -> State ASTState ()
#endif
foldLHsBindsLR = mapM_ (`foldLHsBindLR` Nothing) . bagToList
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLHsBindLR :: LHsBindLR GhcTc GhcTc
-> Maybe Id -- ^ Polymorphic id
-> State ASTState (Maybe Type)
-#else
-foldLHsBindLR :: LHsBindLR Id Id
- -> Maybe Id -- ^ Polymorphic id
- -> State ASTState (Maybe Type)
-#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
foldLHsBindLR (L _span (XHsBindsLR _)) _ = return Nothing
foldLHsBindLR (L _span (PatSynBind _ (XPatSynBind _))) _ = return Nothing
-#endif
+-- TODO: FIXME
foldLHsBindLR (L _span FunBind {..}) mbPolyId
| mg_origin fun_matches == FromSource =
restoreTidyEnv $ do
- let (L idSpan identifier) = fun_id -- monotype
+ let fi@(L _ identifier) = fun_id -- monotype
typ =
case mbPolyId of
Just polyId -> varType polyId
@@ -1389,7 +1236,7 @@ foldLHsBindLR (L _span FunBind {..}) mbPolyId
name = maybe (varName identifier) varName mbPolyId
identifier' = setVarType (setVarName identifier name) typ
(identifier'', _) <- tidyIdentifier identifier'
- addIdentifierToIdSrcSpanMap idSpan identifier'' Nothing
+ addIdentifierToIdSrcSpanMap (getLocA fi) identifier'' Nothing
mapM_ foldLMatch (unLoc (mg_alts fun_matches))
return Nothing
| otherwise = return Nothing
@@ -1408,11 +1255,7 @@ foldLHsBindLR (L _ AbsBindsSig {..}) _ = do
_ <- foldLHsBindLR abs_sig_bind (Just abs_sig_export)
return Nothing
#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
foldLHsBindLR (L _ (PatSynBind _ PSB {..})) _ =
-#else
-foldLHsBindLR (L _ (PatSynBind PSB {..})) _ =
-#endif
restoreTidyEnv $ do
_ <- foldLPat psb_def
_ <-
@@ -1421,98 +1264,75 @@ foldLHsBindLR (L _ (PatSynBind PSB {..})) _ =
(i', _) <- tidyIdentifier i
addIdentifierToIdSrcSpanMap span i' Nothing
in case psb_args of
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
- InfixCon id1 id2 -> addId id1 >> addId id2
- PrefixCon ids -> mapM_ addId ids
+ InfixCon id1 id2 -> addId (reLocN id1) >> addId (reLocN id2)
+ PrefixCon _ ids -> mapM_ (addId . reLocN) ids
RecCon recs ->
mapM_
- (\(RecordPatSynField selId patVar) ->
- addId selId >> addId patVar)
- recs
-#else
- InfixPatSyn id1 id2 -> addId id1 >> addId id2
- PrefixPatSyn ids -> mapM_ addId ids
- RecordPatSyn recs ->
- mapM_
- (\(RecordPatSynField selId patVar) ->
- addId selId >> addId patVar)
+ (\(RecordPatSynField field patVar) ->
+ addId
+ (L ((getLocA . rdrNameFieldOcc) field)
+ (extFieldOcc field))
+ >> addId (reLocN patVar))
recs
-#endif
return Nothing
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLPat :: LPat GhcTc -> State ASTState (Maybe Type)
-#else
-foldLPat :: LPat Id -> State ASTState (Maybe Type)
-#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLPat (ghcDL -> L _span (XPat _)) = return Nothing
-foldLPat (ghcDL -> L _ (NPat _ (L _ (XOverLit _)) _ _)) = return Nothing
-foldLPat (ghcDL -> L _ (NPlusKPat _ (L _ _) (L _ (XOverLit _)) _ _ _)) = return Nothing
-foldLPat (ghcDL -> L span (VarPat _ (L _ identifier))) = do
-#else
-foldLPat (ghcDL -> L span (VarPat (L _ identifier))) = do
-#endif
+foldLPat (L _span (XPat _)) = return Nothing
+foldLPat (L _ (NPat _ (L _ (XOverLit _)) _ _)) = return Nothing
+foldLPat (L _ (NPlusKPat _ (L _ _) (L _ (XOverLit _)) _ _ _)) = return Nothing
+foldLPat lp@(L _ (VarPat _ (L _ identifier))) = do
(identifier', _) <- tidyIdentifier identifier
- addIdentifierToIdSrcSpanMap span identifier' Nothing
+ addIdentifierToIdSrcSpanMap (getLocA lp) identifier' Nothing
return . Just . varType $ identifier'
-foldLPat (ghcDL -> L span pat@(WildPat typ)) = do
+foldLPat lp@(L _ pat@(WildPat typ)) = do
typ' <- tidyType typ
- addExprInfo span (Just typ') "WildPat" (patSort pat)
+ addExprInfo (getLocA lp) (Just typ') "WildPat" (patSort pat)
return $ Just typ'
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLPat (ghcDL -> L span p@(LazyPat _ pat)) = do
-#else
-foldLPat (L span p@(LazyPat pat)) = do
-#endif
+foldLPat lp@(L _ p@(LazyPat _ pat)) = do
mbType <- foldLPat pat
- addExprInfo span mbType "LazyPat" (patSort p)
+ addExprInfo (getLocA lp) mbType "LazyPat" (patSort p)
return mbType
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLPat (ghcDL -> L span p@(AsPat _ (L idSpan identifier) pat)) = do
-#else
-foldLPat (L span p@(AsPat (L idSpan identifier) pat)) = do
-#endif
+foldLPat lp@(L _ p@(AsPat _ id@(L _ identifier) pat)) = do
(identifier', _) <- tidyIdentifier identifier
- addIdentifierToIdSrcSpanMap idSpan identifier' Nothing
- addExprInfo span (Just . varType $ identifier') "AsPat" (patSort p)
+ addIdentifierToIdSrcSpanMap (getLocA id) identifier' Nothing
+ addExprInfo (getLocA lp) (Just . varType $ identifier') "AsPat" (patSort p)
_ <- foldLPat pat
return . Just . varType $ identifier'
#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLPat (ghcDL -> L _span (ParPat _ pat)) = foldLPat pat
+foldLPat (L _span (ParPat _ pat)) = foldLPat pat
#else
-foldLPat (ghcDL -> L _span (ParPat pat)) = foldLPat pat
+foldLPat (L _span (ParPat pat)) = foldLPat pat
#endif
#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLPat (ghcDL -> L span p@(BangPat _ pat)) = do
+foldLPat lp@(L _ p@(BangPat _ pat)) = do
#else
-foldLPat (L span p@(BangPat pat)) = do
+foldLPat lp@(L _ p@(BangPat pat)) = do
#endif
typ <- foldLPat pat
- addExprInfo span typ "BangPat" (patSort p)
+ addExprInfo (getLocA lp) typ "BangPat" (patSort p)
return typ
#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLPat (ghcDL -> L span p@(ListPat (ListPatTc typ _) pats)) = do
+foldLPat lp@(L _ p@(ListPat (ListPatTc typ _) pats)) = do
#else
-foldLPat (L span p@(ListPat pats typ _)) = do
+foldLPat lp@(L _ p@(ListPat pats typ _)) = do
#endif
typ' <- tidyType typ
let listType = mkListTy typ'
- addExprInfo span (Just listType) "ListPat" (patSort p)
+ addExprInfo (getLocA lp) (Just listType) "ListPat" (patSort p)
mapM_ foldLPat pats
return $ Just listType
#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLPat (ghcDL -> L span pat@(TuplePat types pats boxity)) = do
+foldLPat lp@(L _ pat@(TuplePat types pats boxity)) = do
#else
-foldLPat (L span pat@(TuplePat pats boxity types)) = do
+foldLPat lp@(L _ pat@(TuplePat pats boxity types)) = do
#endif
typ' <- tidyType $ mkTupleTy boxity types
- addExprInfo span (Just typ') "TuplePat" (patSort pat)
+ addExprInfo (getLocA lp) (Just typ') "TuplePat" (patSort pat)
mapM_ foldLPat pats
return $ Just typ'
#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLPat (ghcDL -> L _span (SumPat _ pat _ _)) = do
+foldLPat (L _span (SumPat _ pat _ _)) = do
#else
foldLPat (L _span (SumPat pat _ _ _types)) = do
#endif
@@ -1522,80 +1342,73 @@ foldLPat (L _span (SumPat pat _ _ _types)) = do
#endif
#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
#else
-foldLPat (L span pat@(PArrPat pats typ)) = do
+foldLPat lp@(L _ pat@(PArrPat pats typ)) = do
typ' <- tidyType typ
- addExprInfo span (Just typ') "PArrPat" (patSort pat)
+ addExprInfo (getLocA lp) (Just typ') "PArrPat" (patSort pat)
mapM_ foldLPat pats
return $ Just typ'
#endif
-- no more conpatin / conpatout, just conpat
-- foldLPat (ghcDL -> L _span (ConPatIn _ _)) = return Nothing
-foldLPat (ghcDL -> L span pat@ConPat {..}) = do
- let (L idSpan conLike) = pat_con
- conId =
- case conLike of
- RealDataCon dc -> dataConWorkId dc
- PatSynCon ps -> patSynId ps
- typ = conLikeResTy (unLoc pat_con) pat_arg_tys
- (identifier', mbTypes) <- tidyIdentifier conId
- addIdentifierToIdSrcSpanMap idSpan identifier' mbTypes
- typ' <- tidyType typ
- addExprInfo span (Just typ') "ConPat" (patSort pat)
- _ <- foldHsConPatDetails pat_args
- return . Just . varType $ identifier'
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLPat (ghcDL -> L span p@(ViewPat typ expr pat)) = do
-#else
-foldLPat (ghcDL -> L span p@(ViewPat expr pat typ)) = do
-#endif
+-- TODO: FIXME
+-- foldLPat (ghcDL -> cp@lp@(L _ pat@ConPat {..})) = do
+-- let pc@(L _ conLike) = pat_con
+-- conId =
+-- case conLike of
+-- RealDataCon dc -> dataConWorkId dc
+-- PatSynCon ps -> patSynId ps
+-- typ = conLikeResTy (unLoc pat_con) pat_arg_tys
+-- (identifier', mbTypes) <- tidyIdentifier conId
+-- addIdentifierToIdSrcSpanMap (getLocA pc) identifier' mbTypes
+-- typ' <- tidyType typ
+-- addExprInfo (getLocA cp) (Just typ') "ConPat" (patSort pat)
+-- _ <- foldHsConPatDetails pat_args
+-- return . Just . varType $ identifier'
+foldLPat lp@(L _ p@(ViewPat typ expr pat)) = do
typ' <- tidyType typ
- addExprInfo span (Just typ') "ViewPat" (patSort p)
+ addExprInfo (getLocA lp) (Just typ') "ViewPat" (patSort p)
_ <- foldLPat pat
_ <- foldLHsExpr expr
return $ Just typ'
-foldLPat (ghcDL -> L _ SplicePat {}) = return Nothing
+foldLPat (L _ SplicePat {}) = return Nothing
#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLPat (ghcDL -> L span (LitPat _ hsLit)) = do
+foldLPat lp@(L _ (LitPat _ hsLit)) = do
#else
-foldLPat (L span (LitPat hsLit)) = do
+foldLPat lp@(L _ (LitPat hsLit)) = do
#endif
typ' <- tidyType $ hsLitType hsLit
addExprInfo
- span
+ (getLocA lp)
(Just typ')
"LitPat"
- (if isOneLineSpan span
+ (if isOneLineSpan (getLocA lp)
then Simple
else Composite)
return $ Just typ'
#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLPat (ghcDL -> L span pat@(NPat _ (L _spanLit (OverLit (OverLitTc {..}) _ _)) _ _)) = do
+foldLPat lp@(L _ pat@(NPat _ (L _spanLit (OverLit (OverLitTc {..}) _ _)) _ _)) = do
#else
-foldLPat (L span pat@(NPat (L _spanLit OverLit {ol_type}) _ _ _)) = do
+foldLPat lp@(L _ pat@(NPat (L _spanLit OverLit {ol_type}) _ _ _)) = do
#endif
typ' <- tidyType ol_type
- addExprInfo span (Just typ') "NPat" (patSort pat)
+ addExprInfo (getLocA lp) (Just typ') "NPat" (patSort pat)
return $ Just ol_type
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLPat (ghcDL -> L span pat@(NPlusKPat typ (L idSpan identifier) (L litSpan (OverLit (OverLitTc {..}) _ _)) _ _ _)) = do
-#else
-foldLPat (L span pat@(NPlusKPat (L idSpan identifier) (L litSpan OverLit {ol_type}) _ _ _ typ)) = do
-#endif
+foldLPat lp@(L _ pat@(NPlusKPat typ id@(L _ identifier) (L litSpan (OverLit (OverLitTc {..}) _ _)) _ _ _)) = do
(identifier', _) <- tidyIdentifier identifier
- addIdentifierToIdSrcSpanMap idSpan identifier' Nothing
+ addIdentifierToIdSrcSpanMap (getLocA id) identifier' Nothing
typ' <- tidyType typ
- addExprInfo span (Just typ') "NPlusKPat" (patSort pat)
+ addExprInfo (getLocA lp) (Just typ') "NPlusKPat" (patSort pat)
olType' <- tidyType ol_type
addExprInfo
litSpan
(Just olType')
"NPlusKPat"
- (if isOneLineSpan span
+ (if isOneLineSpan (getLocA lp)
then Simple
else Composite)
return $ Just typ'
#if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)
-foldLPat (ghcDL -> L _span (SigPat typ pat _)) = do
+foldLPat (L _span (SigPat typ pat _)) = do
typ' <- tidyType typ
_ <- foldLPat pat
return $ Just typ'
@@ -1611,22 +1424,15 @@ foldLPat (L _span (SigPatOut pat typ)) = do
_ <- foldLPat pat
return $ Just typ'
#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLPat (ghcDL -> L span p@(CoPat _ _ pat typ)) = do
-#else
-foldLPat (L span p@(CoPat _ pat typ)) = do
-#endif
- typ' <- tidyType typ
- addExprInfo span (Just typ') "CoPat" (patSort p)
-#if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)
- _ <- foldLPat (cL span pat)
-#else
- _ <- foldLPat (L span pat)
-#endif
- return Nothing
-#if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)
+-- no copat in lpat in 9.2.2
+-- foldLPat lp@(L span p@(CoPat _ pat typ)) = do
+-- typ' <- tidyType typ
+-- addExprInfo (getLocA lp) (Just typ') "CoPat" (patSort p)
+-- -- cL is similar to dL and not used any more
+-- -- _ <- foldLPat (cL (getLocA lp) pat)
+-- _ <- foldLPat (L span pat)
+-- return Nothing
foldLPat _ = return Nothing
-#endif
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldHsConPatDetails
@@ -1637,7 +1443,7 @@ foldHsConPatDetails
:: HsConPatDetails Id
-> State ASTState (Maybe Type)
#endif
-foldHsConPatDetails (PrefixCon args) = do
+foldHsConPatDetails (PrefixCon _ args) = do
mapM_ foldLPat args
return Nothing
foldHsConPatDetails (RecCon rec) = do
@@ -1656,7 +1462,7 @@ foldHsRecFieldsPat :: HsRecFields Id (LPat Id) -> State ASTState (Maybe Type)
foldHsRecFieldsPat HsRecFields {..} = do
let onlyUserWritten =
case rec_dotdot of
- Just i -> take i
+ Just i -> take $ unLoc i
Nothing -> id
mapM_ foldLHsRecFieldPat $ onlyUserWritten rec_flds
return Nothing
@@ -1666,18 +1472,12 @@ foldLHsRecFieldPat :: LHsRecField GhcTc (LPat GhcTc) -> State ASTState (Maybe Ty
#else
foldLHsRecFieldPat :: LHsRecField Id (LPat Id) -> State ASTState (Maybe Type)
#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsRecFieldPat (L _ (HsRecField (L idSpan (FieldOcc identifier _)) arg pun)) = do
-#else
-foldLHsRecFieldPat (L _ (HsRecField (L idSpan (FieldOcc _ identifier)) arg pun)) = do
-#endif
+foldLHsRecFieldPat (L _ (HsRecField _ (L idSpan (FieldOcc identifier _)) arg pun)) = do
(identifier', mbTypes) <- tidyIdentifier identifier
addIdentifierToIdSrcSpanMap idSpan identifier' mbTypes
unless pun $ void $ foldLPat arg
return . Just . varType $ identifier'
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsRecFieldPat (L _ (HsRecField (L _idSpan (XFieldOcc _)) _arg _pun)) = return Nothing
-#endif
+foldLHsRecFieldPat (L _ (HsRecField _ (L _idSpan (XFieldOcc _)) _arg _pun)) = return Nothing
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLHsCmdTop :: LHsCmdTop GhcTc -> State ASTState (Maybe Type)
@@ -1761,11 +1561,7 @@ foldLHsCmd (L _ (HsCmdIf _ expr cmd1 cmd2)) = do
_ <- foldLHsCmd cmd2
_ <- foldLHsExpr expr
return Nothing
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsCmd (L _ (HsCmdLet _ (L _ binds) cmd)) = do
-#else
-foldLHsCmd (L _ (HsCmdLet (L _ binds) cmd)) = do
-#endif
+foldLHsCmd (L _ (HsCmdLet _ binds cmd)) = do
_ <- foldLHsCmd cmd
_ <- foldHsLocalBindsLR binds
return Nothing