diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2023-01-09 17:58:26 +0000 |
---|---|---|
committer | Alan Zimmerman <alan.zimm@gmail.com> | 2023-01-09 23:24:55 +0000 |
commit | 3de6fe2e619a262c526d336da99e3e97b189d1e1 (patch) | |
tree | 52f18f7e96d42ef9fbfc5745b370f4871008bda4 | |
parent | b3808a7c8b7c58fb428ffb12b8511ce6f59de72d (diff) | |
download | haskell-wip/az/exactprint-epalocation-for-anchor.tar.gz |
-rw-r--r-- | utils/check-exact/ExactPrint.hs | 10 | ||||
-rw-r--r-- | utils/check-exact/Main.hs | 21 | ||||
m--------- | utils/haddock | 0 |
3 files changed, 19 insertions, 12 deletions
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs index 0124bf46b6..0c3086bcb1 100644 --- a/utils/check-exact/ExactPrint.hs +++ b/utils/check-exact/ExactPrint.hs @@ -1385,10 +1385,14 @@ markTopLevelList ls = mapM (\a -> setLayoutTopLevelP $ markAnnotated a) ls instance (ExactPrint a) => ExactPrint (Located a) where getAnnotationEntry (L l _) = case l of UnhelpfulSpan _ -> NoEntryVal - _ -> Entry (hackSrcSpanToAnchor l) emptyComments NoFlushComments CanUpdateAnchorOnly + _ -> Entry (spanAsAnchor l) emptyComments NoFlushComments NoCanUpdateAnchor + -- getAnnotationEntry (L l _) = case l of + -- UnhelpfulSpan _ -> NoEntryVal + -- _ -> Entry (hackSrcSpanToAnchor l) emptyComments NoFlushComments CanUpdateAnchorOnly - setAnnotationAnchor (L _ a) anc _cs = (L (hackAnchorToSrcSpan anc) a) - `debug` ("setAnnotationAnchor(Located):" ++ showAst anc) + -- setAnnotationAnchor (L _ a) anc _cs = (L (hackAnchorToSrcSpan anc) a) + -- `debug` ("setAnnotationAnchor(Located):" ++ showAst anc) + setAnnotationAnchor ls _ _ = ls exact (L l a) = L l <$> markAnnotated a diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs index 6bb552b3c8..0d5f9371c4 100644 --- a/utils/check-exact/Main.hs +++ b/utils/check-exact/Main.hs @@ -54,7 +54,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/epw/_buil -- "../../testsuite/tests/ghc-api/exactprint/LocToName.hs" (Just changeLocToName) -- "../../testsuite/tests/ghc-api/exactprint/LetIn1.hs" (Just changeLetIn1) -- "../../testsuite/tests/ghc-api/exactprint/WhereIn4.hs" (Just changeWhereIn4) - "../../testsuite/tests/ghc-api/exactprint/AddDecl1.hs" (Just changeAddDecl1) + -- "../../testsuite/tests/ghc-api/exactprint/AddDecl1.hs" (Just changeAddDecl1) -- "../../testsuite/tests/ghc-api/exactprint/AddDecl2.hs" (Just changeAddDecl2) -- "../../testsuite/tests/ghc-api/exactprint/AddDecl3.hs" (Just changeAddDecl3) -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls.hs" (Just changeLocalDecls) @@ -304,7 +304,8 @@ testOneFile _ libdir fileName mchanger = do (changedSourceOk, expectedSource, changedSource) <- case mchanger of Just changer -> do - (pped', ast') <- exactprintWithChange libdir changer p + let changer' = changer `debug` ("****Starting to run changer****") + (pped', ast') <- exactprintWithChange libdir changer' p writeBinFile changedAstFile (ppAst ast') writeBinFile newFileChanged pped' @@ -461,8 +462,7 @@ changeAddDecl1 libdir top = do Right decl <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2") let decl' = setEntryDP decl (DifferentLine 2 0) - let (p',_,_) = runTransform doAddDecl - doAddDecl = everywhereM (mkM replaceTopLevelDecls) top + let (p',_,_) = runTransform (replaceTopLevelDecls top) replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource replaceTopLevelDecls m = insertAtStart m decl' return p' @@ -472,10 +472,10 @@ changeAddDecl1 libdir top = do changeAddDecl2 :: Changer changeAddDecl2 libdir top = do Right decl <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2") - let decl' = setEntryDP (makeDeltaAst decl) (DifferentLine 2 0) + let decl' = setEntryDP decl (DifferentLine 2 0) let (p',_,_) = runTransform doAddDecl - doAddDecl = everywhereM (mkM replaceTopLevelDecls) (makeDeltaAst top) + doAddDecl = everywhereM (mkM replaceTopLevelDecls) top replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource replaceTopLevelDecls m = insertAtEnd m decl' return p' @@ -590,12 +590,14 @@ addLocaLDecl1 libdir top = do Right (L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2") let decl' = setEntryDP (L ld decl) (DifferentLine 1 5) doAddLocal = do - let lp = makeDeltaAst top + -- let lp = makeDeltaAst top + let lp = top (de1:d2:d3:_) <- hsDecls lp (de1'',d2') <- balanceComments de1 d2 + let d2'' = setEntryDP d2' (DifferentLine 2 0) (de1',_) <- modifyValD (getLocA de1'') de1'' $ \_m d -> do return ((wrapDecl decl' : d),Nothing) - replaceDecls lp [de1', d2', d3] + replaceDecls lp [de1', d2'', d3] (lp',_,w) <- runTransformT doAddLocal debugM $ "addLocaLDecl1:" ++ intercalate "\n" w @@ -902,7 +904,8 @@ addHiding1 _libdir (L l p) = do []) emptyComments) l0) [v1,v2] imp1' = imp1 { ideclImportList = Just (EverythingBut,impHiding)} - p' = p { hsmodImports = [L li imp1',imp2]} + imp2' = setEntryDP imp2 (DifferentLine 2 0) + p' = p { hsmodImports = [L li imp1',imp2']} return (L l p') let (lp',_,_w) = runTransform doTransform diff --git a/utils/haddock b/utils/haddock -Subproject 261a7c8ac5b5ff29e6e0380690cbb6ee9730f98 +Subproject 519a95998b09a2c9c7a42c3a0cf2ca0c4358bb4 |