From 166265e93de140c4a33f7a61bc004fb64be18275 Mon Sep 17 00:00:00 2001 From: alexwl Date: Tue, 9 Oct 2018 23:13:07 +0300 Subject: WIP. It compiles with ghc-8.4.3, but not all features of the indexer are supported yet. --- src/HaskellCodeExplorer/AST/RenamedSource.hs | 105 ++++++++++++++----- src/HaskellCodeExplorer/AST/TypecheckedSource.hs | 128 +++++++++++++++++------ 2 files changed, 173 insertions(+), 60 deletions(-) (limited to 'src/HaskellCodeExplorer/AST') diff --git a/src/HaskellCodeExplorer/AST/RenamedSource.hs b/src/HaskellCodeExplorer/AST/RenamedSource.hs index c1bf463..ea5a87a 100644 --- a/src/HaskellCodeExplorer/AST/RenamedSource.hs +++ b/src/HaskellCodeExplorer/AST/RenamedSource.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-} @@ -54,10 +55,16 @@ import GHC , PatSynBind(..) , Sig(..) , TyClDecl(..) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +#else , TyFamEqn(..) +#endif , Type , unLoc ) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +import HsExtension (GhcRn) +#endif import HaskellCodeExplorer.GhcUtils (hsPatSynDetails, ieLocNames) import Prelude hiding (span) import TysWiredIn @@ -86,9 +93,12 @@ namesFromRenamedSource = hsTypeNames `extQ` tyClDeclNames `extQ` familyDeclNames `extQ` +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +#else tyFamilyEqNames `extQ` tyFamilyDefEqNames `extQ` dataFamInstDeclNames `extQ` +#endif conDeclNames `extQ` importNames `extQ` hsTyVarBndrNames `extQ` @@ -99,7 +109,9 @@ namesFromRenamedSource = hsRecFieldPatNames `extQ` foreignDeclNames) -fieldOccName :: Bool -> FieldOcc Name -> NameOccurrence +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +fieldOccName :: Bool -> FieldOcc GhcRn -> NameOccurrence +#endif fieldOccName isBinder (FieldOcc (L span _) name) = NameOccurrence { locatedName = L span (Just name) @@ -107,16 +119,20 @@ fieldOccName isBinder (FieldOcc (L span _) name) = , isBinder = isBinder } -conDeclFieldNames :: ConDeclField Name -> [NameOccurrence] +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +conDeclFieldNames :: ConDeclField GhcRn -> [NameOccurrence] +#endif conDeclFieldNames ConDeclField {..} = map (fieldOccName True . unLoc) cd_fld_names -hsRecFieldExprNames :: - HsRecField' (FieldOcc Name) (LHsExpr Name) -> [NameOccurrence] +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +hsRecFieldExprNames :: HsRecField' (FieldOcc GhcRn) (LHsExpr GhcRn) -> [NameOccurrence] +#endif hsRecFieldExprNames HsRecField {..} = [fieldOccName False $ unLoc hsRecFieldLbl] -hsRecAmbFieldExprNames :: - HsRecField' (AmbiguousFieldOcc Name) (LHsExpr Name) -> [NameOccurrence] +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +hsRecAmbFieldExprNames :: HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn) -> [NameOccurrence] +#endif hsRecAmbFieldExprNames HsRecField {..} = let (L span recField) = hsRecFieldLbl mbName = @@ -130,11 +146,14 @@ hsRecAmbFieldExprNames HsRecField {..} = } ] -hsRecFieldPatNames :: - HsRecField' (FieldOcc Name) (LPat Name) -> [NameOccurrence] +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +hsRecFieldPatNames :: HsRecField' (FieldOcc GhcRn) (LPat GhcRn) -> [NameOccurrence] +#endif hsRecFieldPatNames HsRecField {..} = [fieldOccName False $ unLoc hsRecFieldLbl] -hsExprNames :: LHsExpr Name -> [NameOccurrence] +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +hsExprNames :: LHsExpr GhcRn -> [NameOccurrence] +#endif hsExprNames (L _span (HsVar name)) = [ NameOccurrence { locatedName = Just <$> name @@ -174,7 +193,9 @@ hsExprNames (L _span (HsRecFld (Ambiguous (L span _) _name))) = ] hsExprNames _ = [] -matchGroupNames :: MatchGroup Name (LHsExpr Name) -> [NameOccurrence] +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +matchGroupNames :: MatchGroup GhcRn (LHsExpr GhcRn) -> [NameOccurrence] +#endif matchGroupNames = #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) mapMaybe (fmap toNameOcc . matchContextName . m_ctxt . unLoc) . @@ -184,20 +205,22 @@ matchGroupNames = unLoc . mg_alts where #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) - matchContextName :: HsMatchContext Name -> Maybe (Located Name) + --matchContextName :: HsMatchContext Name -> Maybe (Located Name) matchContextName (FunRhs name _ _bool) = Just name matchContextName _ = Nothing #else - matchFixityName :: MatchFixity Name -> Maybe (Located Name) + --matchFixityName :: MatchFixity Name -> Maybe (Located Name) matchFixityName NonFunBindMatch = Nothing matchFixityName (FunBindMatch name _bool) = Just name #endif - toNameOcc :: Located Name -> NameOccurrence + --toNameOcc :: Located Name -> NameOccurrence toNameOcc n = NameOccurrence {locatedName = Just <$> n, description = "Match", isBinder = True} -bindNames :: LHsBindLR Name Name -> [NameOccurrence] +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +bindNames :: LHsBindLR GhcRn GhcRn -> [NameOccurrence] +#endif bindNames (L _span (PatSynBind PSB {..})) = [ NameOccurrence { locatedName = Just <$> psb_id @@ -207,7 +230,6 @@ bindNames (L _span (PatSynBind PSB {..})) = ] bindNames _ = [] -hsPatSynDetailsNames :: HsPatSynDetails (Located Name) -> [NameOccurrence] hsPatSynDetailsNames = map (\name -> @@ -218,7 +240,10 @@ hsPatSynDetailsNames = }) . hsPatSynDetails -importNames :: IE Name -> [NameOccurrence] + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +importNames :: IE GhcRn -> [NameOccurrence] +#endif importNames = map (\name -> @@ -229,7 +254,10 @@ importNames = }) . ieLocNames -patNames :: LPat Name -> [NameOccurrence] + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +patNames :: LPat GhcRn -> [NameOccurrence] +#endif patNames (L _span (VarPat name)) = [ NameOccurrence { locatedName = Just <$> name @@ -260,7 +288,10 @@ patNames (L _span (NPlusKPat name _ _ _ _ _)) = ] patNames _ = [] -sigNames :: LSig Name -> [NameOccurrence] + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +sigNames :: LSig GhcRn -> [NameOccurrence] +#endif sigNames (L _span (TypeSig names _)) = map (\n -> @@ -332,7 +363,10 @@ sigNames (L _span (MinimalSig _ (L _ boolFormula))) = boolFormulaNames (Parens (L _ f)) = boolFormulaNames f sigNames (L _ _) = [] -hsTypeNames :: LHsType Name -> [NameOccurrence] + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +hsTypeNames :: LHsType GhcRn -> [NameOccurrence] +#endif #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) hsTypeNames (L _span (HsTyVar _promoted name)) = #else @@ -382,7 +416,10 @@ hsTypeNames (L span (HsTupleTy tupleSort types)) --hsTypeNames (L span (HsExplicitTupleTy _kind types)) = ... hsTypeNames _ = [] -hsTyVarBndrNames :: HsTyVarBndr Name -> [NameOccurrence] + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +hsTyVarBndrNames :: HsTyVarBndr GhcRn -> [NameOccurrence] +#endif hsTyVarBndrNames (UserTyVar n) = [ NameOccurrence { locatedName = Just <$> n @@ -398,7 +435,9 @@ hsTyVarBndrNames (KindedTyVar n _) = } ] -tyClDeclNames :: LTyClDecl Name -> [NameOccurrence] +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +tyClDeclNames :: LTyClDecl GhcRn -> [NameOccurrence] +#endif tyClDeclNames (L _span DataDecl {..}) = [ NameOccurrence { locatedName = Just <$> tcdLName @@ -432,7 +471,9 @@ tyClDeclNames (L _span ClassDecl {..}) = } tyClDeclNames _ = [] -familyDeclNames :: FamilyDecl Name -> [NameOccurrence] +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +familyDeclNames :: FamilyDecl GhcRn -> [NameOccurrence] +#endif familyDeclNames FamilyDecl {..} = [ NameOccurrence { locatedName = Just <$> fdLName @@ -441,7 +482,11 @@ familyDeclNames FamilyDecl {..} = } ] -tyFamilyEqNames :: TyFamEqn Name (HsTyPats Name) -> [NameOccurrence] + +--TODO +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +#else +--tyFamilyEqNames :: TyFamEqn Name (HsTyPats Name) -> [NameOccurrence] tyFamilyEqNames TyFamEqn {tfe_tycon = tyCon} = [ NameOccurrence { locatedName = Just <$> tyCon @@ -450,7 +495,7 @@ tyFamilyEqNames TyFamEqn {tfe_tycon = tyCon} = } ] -tyFamilyDefEqNames :: TyFamEqn Name (LHsQTyVars Name) -> [NameOccurrence] +--tyFamilyDefEqNames :: TyFamEqn Name (LHsQTyVars Name) -> [NameOccurrence] tyFamilyDefEqNames TyFamEqn {tfe_tycon = tyCon} = [ NameOccurrence { locatedName = Just <$> tyCon @@ -459,7 +504,8 @@ tyFamilyDefEqNames TyFamEqn {tfe_tycon = tyCon} = } ] -dataFamInstDeclNames :: DataFamInstDecl Name -> [NameOccurrence] + +--dataFamInstDeclNames :: DataFamInstDecl Name -> [NameOccurrence] dataFamInstDeclNames DataFamInstDecl {dfid_tycon = tyCon} = [ NameOccurrence { locatedName = Just <$> tyCon @@ -467,8 +513,11 @@ dataFamInstDeclNames DataFamInstDecl {dfid_tycon = tyCon} = , isBinder = False } ] +#endif -conDeclNames :: ConDecl Name -> [NameOccurrence] +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +conDeclNames :: ConDecl GhcRn -> [NameOccurrence] +#endif conDeclNames con = case con of ConDeclGADT {con_names = names} -> @@ -488,7 +537,9 @@ conDeclNames con = } ] -foreignDeclNames :: ForeignDecl Name -> [NameOccurrence] +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foreignDeclNames :: ForeignDecl GhcRn -> [NameOccurrence] +#endif foreignDeclNames decl = [ NameOccurrence { locatedName = Just <$> fd_name decl diff --git a/src/HaskellCodeExplorer/AST/TypecheckedSource.hs b/src/HaskellCodeExplorer/AST/TypecheckedSource.hs index f97c33b..4dfbd8b 100644 --- a/src/HaskellCodeExplorer/AST/TypecheckedSource.hs +++ b/src/HaskellCodeExplorer/AST/TypecheckedSource.hs @@ -80,6 +80,7 @@ import HsSyn , selectorAmbiguousFieldOcc ) import HscTypes (TypeEnv, lookupTypeEnv) +import HsExtension (GhcTc) import Id (idType) import IdInfo (IdDetails(..)) import InstEnv @@ -541,11 +542,15 @@ tidyType typ = do let (tidyEnv', typ') = tidyOpenType tidyEnv typ modify' (\s -> s {astStateTidyEnv = tidyEnv'}) return typ' - -foldTypecheckedSource :: LHsBinds Id -> State ASTState () + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldTypecheckedSource :: LHsBinds GhcTc -> State ASTState () +#endif foldTypecheckedSource = foldLHsBindsLR -foldLHsExpr :: LHsExpr Var -> State ASTState (Maybe Type) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldLHsExpr :: LHsExpr GhcTc -> State ASTState (Maybe Type) +#endif foldLHsExpr (L span (HsVar (L _ identifier))) = restoreTidyEnv $ do (identifier', mbTypes) <- tidyIdentifier identifier @@ -801,8 +806,10 @@ foldLHsExpr (L span (HsWrap wrapper expr)) = Composite -> return () -- Not sure if it is possible typ <- foldLHsExpr (L span expr) return $ applyWrapper wrapper <$> typ - -foldHsRecFields :: HsRecFields Id (LHsExpr Id) -> State ASTState (Maybe Type) + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldHsRecFields :: HsRecFields GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type) +#endif foldHsRecFields HsRecFields {..} = do let userWritten = case rec_dotdot of @@ -810,8 +817,10 @@ foldHsRecFields HsRecFields {..} = do Nothing -> id mapM_ foldLHsRecField $ userWritten rec_flds return Nothing - -foldLHsRecField :: LHsRecField Id (LHsExpr Id) -> State ASTState (Maybe Type) + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldLHsRecField :: LHsRecField GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type) +#endif foldLHsRecField (L span (HsRecField (L idSpan (FieldOcc _ identifier)) arg pun)) = restoreTidyEnv $ do (identifier', mbTypes) <- tidyIdentifier identifier @@ -820,7 +829,9 @@ foldLHsRecField (L span (HsRecField (L idSpan (FieldOcc _ identifier)) arg pun)) unless pun $ void (foldLHsExpr arg) return . Just . varType $ identifier' -foldLHsRecUpdField :: LHsRecUpdField Id -> State ASTState (Maybe Type) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldLHsRecUpdField :: LHsRecUpdField GhcTc -> State ASTState (Maybe Type) +#endif foldLHsRecUpdField (L span (HsRecField (L idSpan recField) arg pun)) = restoreTidyEnv $ do let selectorId = selectorAmbiguousFieldOcc recField @@ -844,7 +855,9 @@ data TupArg | TupArgMissing deriving (Show, Eq) -foldLHsTupArg :: LHsTupArg Id -> State ASTState (Maybe Type, TupArg) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldLHsTupArg :: LHsTupArg GhcTc -> State ASTState (Maybe Type, TupArg) +#endif foldLHsTupArg (L _span (Present expr)) = restoreTidyEnv $ do typ <- foldLHsExpr expr @@ -858,31 +871,41 @@ foldLHsTupArg (L _ (Missing typ)) = typ' <- tidyType typ return (Just typ', TupArgMissing) -foldLMatch :: LMatch Id (LHsExpr Var) -> State ASTState (Maybe Type) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldLMatch :: LMatch GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type) +#endif foldLMatch (L _span Match {..}) = do mapM_ foldLPat m_pats _ <- foldGRHSs m_grhss return Nothing - -foldLMatchCmd :: LMatch Id (LHsCmd Var) -> State ASTState (Maybe Type) + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldLMatchCmd :: LMatch GhcTc (LHsCmd GhcTc) -> State ASTState (Maybe Type) +#endif foldLMatchCmd (L _span Match {..}) = do mapM_ foldLPat m_pats _ <- foldGRHSsCmd m_grhss return Nothing -foldGRHSsCmd :: GRHSs Id (LHsCmd Id) -> State ASTState (Maybe Type) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldGRHSsCmd :: GRHSs GhcTc (LHsCmd GhcTc) -> State ASTState (Maybe Type) +#endif foldGRHSsCmd GRHSs {..} = do mapM_ foldLGRHSCmd grhssGRHSs _ <- foldHsLocalBindsLR (unLoc grhssLocalBinds) return Nothing -foldGRHSs :: GRHSs Id (LHsExpr Var) -> State ASTState (Maybe Type) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldGRHSs :: GRHSs GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type) +#endif foldGRHSs GRHSs {..} = do mapM_ foldLGRHS grhssGRHSs _ <- foldHsLocalBindsLR (unLoc grhssLocalBinds) return Nothing -foldLStmtLR :: LStmtLR Id Id (LHsExpr Var) -> State ASTState (Maybe Type) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldLStmtLR :: LStmtLR GhcTc GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type) +#endif foldLStmtLR (L span (LastStmt body _ _)) = do typ <- foldLHsExpr body addExprInfo span typ "LastStmt" Composite @@ -916,10 +939,16 @@ foldLStmtLR (L span (ApplicativeStmt args _ typ)) = addExprInfo span (Just typ') "ApplicativeStmt" Composite return Nothing -foldApplicativeArg :: ApplicativeArg Id Id -> State ASTState (Maybe Type) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldApplicativeArg :: ApplicativeArg GhcTc GhcTc -> State ASTState (Maybe Type) +#endif foldApplicativeArg appArg = case appArg of +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) + ApplicativeArgOne pat expr _bool -> do +#else ApplicativeArgOne pat expr -> do +#endif _ <- foldLPat pat _ <- foldLHsExpr expr return Nothing @@ -927,9 +956,10 @@ foldApplicativeArg appArg = _ <- mapM_ foldLStmtLR exprStmts _ <- foldLPat pat return Nothing - -foldLStmtLRCmd :: LStmtLR Id Id (LHsCmd Var) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldLStmtLRCmd :: LStmtLR GhcTc GhcTc (LHsCmd GhcTc) -> State ASTState (Maybe Type) +#endif foldLStmtLRCmd (L span (LastStmt body _syntaxExpr _)) = do typ <- foldLHsCmd body addExprInfo span typ "LastStmt Cmd" Composite @@ -962,43 +992,57 @@ foldLStmtLRCmd (L span (ApplicativeStmt args _ typ)) = mapM_ (foldApplicativeArg . snd) args addExprInfo span (Just typ') "ApplicativeStmt Cmd" Composite return Nothing - -foldLGRHS :: LGRHS Id (LHsExpr Id) -> State ASTState (Maybe Type) + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldLGRHS :: LGRHS GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type) +#endif foldLGRHS (L _span (GRHS guards body)) = do typ <- foldLHsExpr body mapM_ foldLStmtLR guards return typ - -foldLGRHSCmd :: LGRHS Id (LHsCmd Var) -> State ASTState (Maybe Type) + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldLGRHSCmd :: LGRHS GhcTc (LHsCmd GhcTc) -> State ASTState (Maybe Type) +#endif foldLGRHSCmd (L _span (GRHS guards body)) = do typ <- foldLHsCmd body mapM_ foldLStmtLR guards return typ -foldParStmtBlock :: ParStmtBlock Id Id -> State ASTState (Maybe Type) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldParStmtBlock :: ParStmtBlock GhcTc GhcTc -> State ASTState (Maybe Type) +#endif foldParStmtBlock (ParStmtBlock exprStmts _ids _syntaxExpr) = do mapM_ foldLStmtLR exprStmts return Nothing -foldHsLocalBindsLR :: HsLocalBindsLR Id Id -> State ASTState (Maybe Type) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldHsLocalBindsLR :: HsLocalBindsLR GhcTc GhcTc -> State ASTState (Maybe Type) +#endif foldHsLocalBindsLR (HsValBinds binds) = do _ <- foldHsValBindsLR binds return Nothing foldHsLocalBindsLR (HsIPBinds _binds) = return Nothing foldHsLocalBindsLR EmptyLocalBinds = return Nothing -foldHsValBindsLR :: HsValBindsLR Id Var -> State ASTState (Maybe Type) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldHsValBindsLR :: HsValBindsLR GhcTc GhcTc -> State ASTState (Maybe Type) +#endif foldHsValBindsLR (ValBindsIn _ _) = return Nothing foldHsValBindsLR (ValBindsOut binds _) = do _ <- mapM_ (foldLHsBindsLR . snd) binds return Nothing -foldLHsBindsLR :: LHsBinds Id -> State ASTState () +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldLHsBindsLR :: LHsBinds GhcTc -> State ASTState () +#endif foldLHsBindsLR = mapM_ (`foldLHsBindLR` Nothing) . bagToList -foldLHsBindLR :: LHsBindLR Id Var +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldLHsBindLR :: LHsBindLR GhcTc GhcTc -> Maybe Id -- ^ Polymorphic id -> State ASTState (Maybe Type) +#endif foldLHsBindLR (L _span FunBind {..}) mbPolyId | mg_origin fun_matches == FromSource = restoreTidyEnv $ do @@ -1024,12 +1068,17 @@ foldLHsBindLR (L _ AbsBinds {..}) _ = do mapM_ (\(bind, typ) -> foldLHsBindLR bind (Just typ)) $ zip (bagToList abs_binds) (map abe_poly abs_exports) return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +#else foldLHsBindLR (L _ AbsBindsSig {..}) _ = do _ <- foldLHsBindLR abs_sig_bind (Just abs_sig_export) return Nothing +#endif foldLHsBindLR (L _ (PatSynBind PSB {..})) _ = restoreTidyEnv $ do _ <- foldLPat psb_def +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +#else _ <- let addId :: GenLocated SrcSpan Id -> State ASTState () addId (L span i) = do @@ -1043,9 +1092,12 @@ foldLHsBindLR (L _ (PatSynBind PSB {..})) _ = (\(RecordPatSynField selId patVar) -> addId selId >> addId patVar) recs +#endif return Nothing -foldLPat :: LPat Id -> State ASTState (Maybe Type) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldLPat :: LPat GhcTc -> State ASTState (Maybe Type) +#endif foldLPat (L span (VarPat (L _ identifier))) = do (identifier', _) <- tidyIdentifier identifier addIdentifierToIdSrcSpanMap span identifier' Nothing @@ -1151,9 +1203,11 @@ foldLPat (L span p@(CoPat _ pat typ)) = do _ <- foldLPat (L span pat) return Nothing +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) foldHsConPatDetails - :: HsConPatDetails Id + :: HsConPatDetails GhcTc -> State ASTState (Maybe Type) +#endif foldHsConPatDetails (PrefixCon args) = do _ <- mapM_ foldLPat args return Nothing @@ -1165,7 +1219,9 @@ foldHsConPatDetails (InfixCon arg1 arg2) = do _ <- foldLPat arg2 return Nothing -foldHsRecFieldsPat :: HsRecFields Id (LPat Id) -> State ASTState (Maybe Type) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldHsRecFieldsPat :: HsRecFields GhcTc (LPat GhcTc) -> State ASTState (Maybe Type) +#endif foldHsRecFieldsPat HsRecFields {..} = do let onlyUserWritten = case rec_dotdot of @@ -1174,20 +1230,26 @@ foldHsRecFieldsPat HsRecFields {..} = do _ <- mapM_ foldLHsRecFieldPat $ onlyUserWritten rec_flds return Nothing -foldLHsRecFieldPat :: LHsRecField Id (LPat Id) -> State ASTState (Maybe Type) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldLHsRecFieldPat :: LHsRecField GhcTc (LPat GhcTc) -> State ASTState (Maybe Type) +#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' -foldLHsCmdTop :: LHsCmdTop Id -> State ASTState (Maybe Type) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldLHsCmdTop :: LHsCmdTop GhcTc -> State ASTState (Maybe Type) +#endif foldLHsCmdTop (L span (HsCmdTop cmd _ _ _)) = do mbTyp <- foldLHsCmd cmd addExprInfo span mbTyp "HsCmdTop" Composite return mbTyp -foldLHsCmd :: LHsCmd Id -> State ASTState (Maybe Type) +#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +foldLHsCmd :: LHsCmd GhcTc -> State ASTState (Maybe Type) +#endif foldLHsCmd (L _ (HsCmdArrApp expr1 expr2 _ _ _)) = do _ <- foldLHsExpr expr1 _ <- foldLHsExpr expr2 -- cgit v1.2.3