diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2025-01-21 v1.12.0.0 + * Harmonise layout processing so we do not have a special case for + the top level This is a breaking change, in that the hand-crafted + different line deltas will have to have 1 subtracted from the + column. 2024-12-06 v1.11.0.0 * Support GHC 9.12.1 (rc1) 2024-05-21 v1.10.0.0 diff --git a/ghc-exactprint.cabal b/ghc-exactprint.cabal --- a/ghc-exactprint.cabal +++ b/ghc-exactprint.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: ghc-exactprint -version: 1.11.0.0 +version: 1.12.0.0 synopsis: ExactPrint for GHC description: Using the API Annotations available from GHC 9.2.1, this library provides a means to round trip any code that can diff --git a/src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs b/src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs --- a/src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs +++ b/src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs @@ -111,16 +111,19 @@ defaultEPState :: EPState defaultEPState = EPState - { epPos = (1,1) - , dLHS = 0 - , pMarkLayout = False - , pLHS = 0 - , dMarkLayout = False - , dPriorEndPosition = (1,1) - , uAnchorSpan = badRealSrcSpan + { uAnchorSpan = badRealSrcSpan , uExtraDP = Nothing , uExtraDPReturn = Nothing , pAcceptSpan = False + + , epPos = (1,1) + , pMarkLayout = False + , pLHS = LayoutStartCol 1 + + , dPriorEndPosition = (1,1) + , dMarkLayout = False + , dLHS = LayoutStartCol 1 + , epComments = [] , epCommentsApplied = [] , epEof = Nothing @@ -457,7 +460,6 @@ -- delta phase variables ----------------------------------- -- Calculate offset required to get to the start of the SrcSPan !off <- getLayoutOffsetD - let spanStart = ss2pos curAnchor priorEndAfterComments <- getPriorEndD let edp' = adjustDeltaForOffset -- Use the propagated offset if one is set @@ -485,6 +487,7 @@ when (isJust medr) $ setExtraDPReturn medr -- --------------------------------------------- -- Preparation complete, perform the action + let spanStart = ss2pos curAnchor when (priorEndAfterComments < spanStart) (do debugM $ "enterAnn.dPriorEndPosition:spanStart=" ++ show spanStart modify (\s -> s { dPriorEndPosition = spanStart } )) @@ -517,8 +520,8 @@ Just (pos, prior) -> do let dp = if pos == prior then (DifferentLine 1 0) - else origDelta pos prior - debugM $ "EOF:(pos,posEnd,prior,dp) =" ++ showGhc (ss2pos pos, ss2posEnd pos, ss2pos prior, dp) + else adjustDeltaForOffset off (origDelta pos prior) + debugM $ "EOF:(pos,posend,prior,off,dp) =" ++ show (ss2pos pos, ss2posEnd pos, ss2pos prior, off, dp) printStringAtLsDelta dp "" setEofPos Nothing -- Only do this once @@ -547,8 +550,8 @@ return after else return [] !trailing' <- markTrailing trailing_anns - -- mapM_ printOneComment (concatMap tokComment $ following) addCommentsA following + debugM $ "enterAnn:done:(anchor,priorCs,postCs) =" ++ show (showAst anchor', priorCs, postCs) -- Update original anchor, comments based on the printing process -- TODO:AZ: probably need to put something appropriate in instead of noSrcSpan @@ -1392,7 +1395,7 @@ dp' <- case mep of Just (EpaDelta _ edp _) -> do debugM $ "printOneComment:edp=" ++ show edp - adjustDeltaForOffsetM edp + return edp _ -> return dp -- Start of debug printing LayoutStartCol dOff <- getLayoutOffsetD @@ -1405,31 +1408,10 @@ updateAndApplyComment (Comment str anc pp mo) dp = do applyComment (Comment str anc' pp mo) where - (r,c) = ss2posEnd pp - dp'' = case anc of - EpaDelta _ dp1 _ -> dp1 - EpaSpan (RealSrcSpan la _) -> - if r == 0 - then (ss2delta (r,c+0) la) - else (ss2delta (r,c) la) - EpaSpan (UnhelpfulSpan _) -> SameLine 0 - dp' = case anc of - EpaSpan (RealSrcSpan r1 _) -> - if pp == r1 - then dp - else dp'' - _ -> dp'' ss = case anc of EpaSpan ss' -> ss' _ -> noSrcSpan - op' = case dp' of - SameLine n -> if n >= 0 - then EpaDelta ss dp' NoComments - else EpaDelta ss dp NoComments - _ -> EpaDelta ss dp' NoComments - anc' = if str == "" && op' == EpaDelta ss (SameLine 0) NoComments -- EOF comment - then EpaDelta ss dp NoComments - else EpaDelta ss dp NoComments + anc' = EpaDelta ss dp NoComments -- --------------------------------------------------------------------- @@ -1470,11 +1452,6 @@ markAnnotatedWithLayout a = setLayoutBoth $ markAnnotated a -- --------------------------------------------------------------------- - -markTopLevelList :: (Monad m, Monoid w) => ExactPrint ast => [ast] -> EP w m [ast] -markTopLevelList ls = mapM (\a -> setLayoutTopLevelP $ markAnnotated a) ls - --- --------------------------------------------------------------------- -- End of utility functions -- --------------------------------------------------------------------- -- Start of ExactPrint instances @@ -1545,11 +1522,11 @@ an0 <- markLensTok an lam_mod m' <- markAnnotated m - mdeprec' <- setLayoutTopLevelP $ markAnnotated mdeprec + mdeprec' <- markAnnotated mdeprec - mexports' <- setLayoutTopLevelP $ markAnnotated mexports + mexports' <- markAnnotated mexports - an1 <- setLayoutTopLevelP $ markLensTok an0 lam_where + an1 <- markLensTok an0 lam_where return (an1, Just m', mdeprec', mexports') @@ -1600,8 +1577,8 @@ setAnnotationAnchor mid _anc _ cs = mid { id_cs = priorComments cs ++ getFollowingComments cs } `debug` ("HsModuleImpDecls.setAnnotationAnchor:cs=" ++ showAst cs) exact (HsModuleImpDecls cs imports decls) = do - imports' <- markTopLevelList imports - decls' <- markTopLevelList (filter notDocDecl decls) + imports' <- mapM markAnnotated imports + decls' <- mapM markAnnotated (filter notDocDecl decls) return (HsModuleImpDecls cs imports' decls') @@ -4906,18 +4883,6 @@ , pMarkLayout = False , pLHS = oldAnchorOffset} ) k <* reset - --- Use 'local', designed for this -setLayoutTopLevelP :: (Monad m, Monoid w) => EP w m a -> EP w m a -setLayoutTopLevelP k = do - debugM $ "setLayoutTopLevelP entered" - oldAnchorOffset <- getLayoutOffsetP - modify (\a -> a { pMarkLayout = False - , pLHS = 0} ) - r <- k - debugM $ "setLayoutTopLevelP:resetting" - setLayoutOffsetP oldAnchorOffset - return r ------------------------------------------------------------------------ diff --git a/src/Language/Haskell/GHC/ExactPrint/Transform.hs b/src/Language/Haskell/GHC/ExactPrint/Transform.hs --- a/src/Language/Haskell/GHC/ExactPrint/Transform.hs +++ b/src/Language/Haskell/GHC/ExactPrint/Transform.hs @@ -301,7 +301,9 @@ line = getDeltaLine delta col = deltaColumn delta edp' = if line == 0 then SameLine col - else DifferentLine line col + else DifferentLine line (col - 1) + -- At the top level the layout offset is 1, adjust for it + -- TODO: what about the layout offset for nested items? edp = edp' `debug` ("setEntryDP :" ++ showGhc (edp', (ss2pos $ epaLocationRealSrcSpan $ getLoc lc), r)) @@ -528,7 +530,7 @@ anc2 = comments an2 (p1,m1,f1) = splitComments (anchorFromLocatedA la1) anc1 - cs1p = priorCommentsDeltas (anchorFromLocatedA la1) p1 + cs1p = priorCommentsDeltas (anchorFromLocatedA la1) p1 -- Split cs1 following comments into those before any -- TrailingAnn's on an1, and any after @@ -769,6 +771,7 @@ oldDecls = hsDecls t oldDeclsb = balanceCommentsList oldDecls oldDecls' = oldDeclsb + `debug` ("insertAt: oldDeclsb:" ++ showAst oldDeclsb) -- |Insert a declaration at the beginning or end of the subdecls of the given -- AST item @@ -1113,8 +1116,8 @@ newWhereAnnotation :: WithWhere -> (EpAnn (AnnList (EpToken "where"))) newWhereAnnotation ww = an where - anc = EpaDelta noSrcSpan (DifferentLine 1 3) [] - anc2 = EpaDelta noSrcSpan (DifferentLine 1 5) [] + anc = EpaDelta noSrcSpan (DifferentLine 1 2) [] + anc2 = EpaDelta noSrcSpan (DifferentLine 1 4) [] w = case ww of WithWhere -> EpTok (EpaDelta noSrcSpan (SameLine 0) []) WithoutWhere -> NoEpTok diff --git a/src/Language/Haskell/GHC/ExactPrint/Utils.hs b/src/Language/Haskell/GHC/ExactPrint/Utils.hs --- a/src/Language/Haskell/GHC/ExactPrint/Utils.hs +++ b/src/Language/Haskell/GHC/ExactPrint/Utils.hs @@ -170,7 +170,7 @@ -- --------------------------------------------------------------------- adjustDeltaForOffset :: LayoutStartCol -> DeltaPos -> DeltaPos -adjustDeltaForOffset _colOffset dp@(SameLine _) = dp +adjustDeltaForOffset _colOffset dp@(SameLine _) = dp adjustDeltaForOffset (LayoutStartCol colOffset) (DifferentLine l c) = DifferentLine l (c - colOffset) @@ -225,14 +225,17 @@ -- does not already have one. commentOrigDelta :: LEpaComment -> LEpaComment commentOrigDelta (L (EpaSpan ss@(RealSrcSpan la _)) (GHC.EpaComment t pp)) - = (L (EpaDelta ss dp NoComments) (GHC.EpaComment t pp)) - `debug` ("commentOrigDelta: (la, pp, r,c, dp)=" ++ showAst (la, pp, r,c, dp)) + = (L (EpaDelta ss dp' NoComments) (GHC.EpaComment t pp)) + `debug` ("commentOrigDelta: (la, pp, r,c, dp, dp')=" ++ showAst (la, pp, r,c, dp, dp')) where (r,c) = ss2posEnd pp dp = if r == 0 then (ss2delta (r,c+1) la) else (ss2delta (r,c) la) + dp' = case dp of + SameLine _ -> dp + DifferentLine l cc -> DifferentLine l (cc - 1) commentOrigDelta c = c origDelta :: RealSrcSpan -> RealSrcSpan -> DeltaPos diff --git a/tests/Test.hs b/tests/Test.hs --- a/tests/Test.hs +++ b/tests/Test.hs @@ -54,8 +54,6 @@ main :: IO () main = hSilence [stderr] $ do print ghcVersion - cwd <- getCurrentDirectory - putStrLn $ "cwd:" ++ show cwd tests <- mkTests cnts <- fst <$> runTestText (putTextToHandle stdout True) tests putStrLn $ show cnts @@ -214,7 +212,9 @@ -- mkParserTest libdir "ghc912" "Module.hs" -- mkParserTest libdir "ghc912" "tests.hs" - mkParserTestMD libdir "ghc912" "Fff.hs" + -- mkParserTestMD libdir "ghc912" "Fff.hs" + -- mkParserTestMD libdir "transform" "AddLocalDecl5.hs" + mkParserTestBC libdir "transform" "AddLocalDecl5.hs" -- mkParserTestMD libdir "ghc912" "Module.hs" -- mkParserTestMD libdir "ghc912" "Operator.hs" -- Needs GHC changes diff --git a/tests/Test/Common.hs b/tests/Test/Common.hs --- a/tests/Test/Common.hs +++ b/tests/Test/Common.hs @@ -109,7 +109,6 @@ changeBalanceComments :: Changer changeBalanceComments _libdir top = do - -- let (GHC.L l p) = makeDeltaAst top let (GHC.L l p) = top let decls0 = GHC.hsmodDecls p decls = balanceCommentsList decls0 diff --git a/tests/Test/Transform.hs b/tests/Test/Transform.hs --- a/tests/Test/Transform.hs +++ b/tests/Test/Transform.hs @@ -29,7 +29,7 @@ transformTestsTT :: LibDir -> Test transformTestsTT libdir = TestLabel "transformTestsTT" $ TestList [ - mkTestModChange libdir changeWhereIn3b "WhereIn3b.hs" + mkTestModChange libdir addLocaLDecl5 "AddLocalDecl5.hs" ] transformTests :: LibDir -> Test @@ -130,8 +130,8 @@ replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs) -> Transform (LMatch GhcPs (LHsExpr GhcPs)) replaceLocalBinds (L lm (Match ma mln pats (GRHSs _ rhs EmptyLocalBinds{}))) = do - let anc = (EpaDelta noSrcSpan (DifferentLine 1 3) []) - let anc2 = (EpaDelta noSrcSpan (DifferentLine 1 5) []) + let anc = (EpaDelta noSrcSpan (DifferentLine 1 2) []) + let anc2 = (EpaDelta noSrcSpan (DifferentLine 1 4) []) let an = EpAnn anc (AnnList (Just anc2) ListNone [] @@ -168,9 +168,7 @@ os' = setEntryDP os (DifferentLine 2 0) let sortKey = captureOrderBinds decls let (EpAnn anc (AnnList (Just _) a b c dd) cs) = van - let van' = (EpAnn anc (AnnList (Just (EpaDelta noSrcSpan (DifferentLine 1 5) [])) a b c dd) cs) - -- let (EpAnn anc (AnnList (Just _) a b c dd) cs) = van - -- let van' = (EpAnn anc (AnnList (Just (EpaDelta (DifferentLine 1 5) [])) a b c dd) cs) + let van' = (EpAnn anc (AnnList (Just (EpaDelta noSrcSpan (DifferentLine 1 4) [])) a b c dd) cs) let binds' = (HsValBinds van' (ValBinds sortKey (decl':oldBinds) (sig':os':oldSigs))) @@ -391,10 +389,10 @@ addLocaLDecl5 :: Changer addLocaLDecl5 _libdir lp = do let - doAddLocal = replaceDecls lp [s1,de1',d3'] + doAddLocal = replaceDecls lp (s1:de1':d3':ds) where decls = hsDecls lp - [s1,de1,d2,d3] = balanceCommentsList decls + (s1:de1:d2:d3:ds) = balanceCommentsList decls d3' = setEntryDP d3 (DifferentLine 2 0) diff --git a/tests/examples/ghc912/Fff.hs b/tests/examples/ghc912/Fff.hs --- a/tests/examples/ghc912/Fff.hs +++ b/tests/examples/ghc912/Fff.hs @@ -1,1 +1,8 @@ -test = foo . not . not +yes p1 p2 + | g1 = e1 + + +foo = 3 + where + yes p1 p2 + | g1 = e1