ghc-exactprint 1.11.0.0 → 1.12.0.0
raw patch · 9 files changed
+57/−77 lines, 9 files
Files
- ChangeLog +5/−0
- ghc-exactprint.cabal +1/−1
- src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs +21/−56
- src/Language/Haskell/GHC/ExactPrint/Transform.hs +7/−4
- src/Language/Haskell/GHC/ExactPrint/Utils.hs +6/−3
- tests/Test.hs +3/−3
- tests/Test/Common.hs +0/−1
- tests/Test/Transform.hs +6/−8
- tests/examples/ghc912/Fff.hs +8/−1
ChangeLog view
@@ -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
ghc-exactprint.cabal view
@@ -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
src/Language/Haskell/GHC/ExactPrint/ExactPrint.hs view
@@ -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 ------------------------------------------------------------------------
src/Language/Haskell/GHC/ExactPrint/Transform.hs view
@@ -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
src/Language/Haskell/GHC/ExactPrint/Utils.hs view
@@ -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
tests/Test.hs view
@@ -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
tests/Test/Common.hs view
@@ -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
tests/Test/Transform.hs view
@@ -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)
tests/examples/ghc912/Fff.hs view
@@ -1,1 +1,8 @@-test = foo . not . not+yes p1 p2+ | g1 = e1+++foo = 3+ where+ yes p1 p2+ | g1 = e1