[Refactor] Replacements report what was the fill

Author: Tritlo

src/Synth/Repair.hs

@@ -111,14 +111,21 @@ justTcExpr cc parsed = do
 getExprTy :: HscEnv -> LHsExpr GhcTc -> IO (Maybe Type)
 getExprTy hsc_env expr = fmap CoreUtils.exprType . snd <$> deSugarExpr hsc_env expr
 
-replacements :: LHsExpr GhcPs -> [[HsExpr GhcPs]] -> [([SrcSpan], LHsExpr GhcPs)]
+replacements :: LHsExpr GhcPs -> [[HsExpr GhcPs]] -> [([(SrcSpan, HsExpr GhcPs)], LHsExpr GhcPs)]
 replacements r [] = [([], r)]
 replacements e (first_hole_fit : rest) = concat rest_fit_res
   where
-    res = map (\(l, e) -> ([l], e)) (mapMaybe (fillHole e) first_hole_fit)
-    (first_fit_locs, first_fit_res) = unzip res
-    rest_fit_res = zipWith addL first_fit_locs $ map (`replacements` rest) first_fit_res
-    addL :: [SrcSpan] -> [([SrcSpan], LHsExpr GhcPs)] -> [([SrcSpan], LHsExpr GhcPs)]
+    -- mapMaybe', but keep the result
+    mapMaybe' :: (a -> Maybe b) -> [a] -> [(a, b)]
+    mapMaybe' _ [] = []
+    mapMaybe' f (a : as) = (case f a of Just b -> ((a, b) :); _ -> id) $ mapMaybe' f as
+    res = map (\(e, (l, r)) -> ([(l, e)], r)) (mapMaybe' (fillHole e) first_hole_fit)
+    (first_fit_locs_and_e, first_fit_res) = unzip res
+    rest_fit_res = zipWith addL first_fit_locs_and_e $ map (`replacements` rest) first_fit_res
+    addL ::
+      [(SrcSpan, HsExpr GhcPs)] ->
+      [([(SrcSpan, HsExpr GhcPs)], LHsExpr GhcPs)] ->
+      [([(SrcSpan, HsExpr GhcPs)], LHsExpr GhcPs)]
     addL srcs reses = map (first (srcs ++)) reses
 
 -- Translate from the old String based version to the new LHsExpr version.
@@ -307,7 +314,7 @@ repair cc tp@EProb {..} =
     -- We add the context by replacing a hole in a let.
     let inContext = noLoc . HsLet NoExtField e_ctxt
         holeyContext = inContext hole
-        undefContext = inContext $ noLoc $ HsVar NoExtField $ noLoc $ mkVarUnqual $ fsLit "undefined"
+        undefContext = inContext $ noLoc undefVar
 
     -- We find expressions that can be used as candidates in the program
     expr_cands <- getExprFitCands cc undefContext

src/Synth/Util.hs

@@ -5,6 +5,7 @@ import Data.Bits
 import Data.Char (isSpace)
 import Data.List (intercalate, sort)
 import GHC
+import GhcPlugins (fsLit, mkVarUnqual)
 import SrcLoc
 import Synth.Types
 import System.Environment (getArgs)
@@ -14,6 +15,9 @@ progAtTy :: EExpr -> EType -> EExpr
 progAtTy e_prog e_ty =
   noLoc $ ExprWithTySig NoExtField (noLoc $ HsPar NoExtField e_prog) e_ty
 
+undefVar :: HsExpr GhcPs
+undefVar = HsVar NoExtField $ noLoc $ mkVarUnqual $ fsLit "undefined"
+
 -- Removes whitespace before and after a string
 trim :: String -> String
 trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace

tests/Tests.hs

@@ -9,7 +9,7 @@ import Data.Bits (finiteBitSize)
 import Data.Dynamic (fromDynamic)
 import Data.List (find)
 import qualified Data.Map as Map
-import Data.Maybe (isJust)
+import Data.Maybe (isJust, mapMaybe)
 import Data.Tree
 import Data.Tuple (swap)
 import GhcPlugins (GenLocated (L), getLoc, unLoc)
@@ -23,6 +23,7 @@ import Synth.Eval
     showUnsafe,
     traceTarget,
   )
+import Synth.Fill (fillHole)
 import Synth.Flatten
 import Synth.Repair
   ( failingProps,
@@ -455,7 +456,23 @@ sanctifyTests =
           expr <- runJustParseExpr cc' r_prog
           -- There are 7 ways to replace parts of the broken function in BrokenModule
           -- with holes:
-          length (sanctifyExpr expr) @?= 7
+          length (sanctifyExpr expr) @?= 7,
+      localOption (mkTimeout 1_000_000) $
+        testCase "Fill foldl program" $ do
+          let cc =
+                CompConf
+                  { hole_lvl = 0,
+                    packages = ["base", "process", "QuickCheck"],
+                    importStmts = ["import Prelude"]
+                  }
+              toFix = "tests/BrokenModule.hs"
+              repair_target = Just "broken"
+          (cc', _, [RProb {..}]) <- moduleToProb cc toFix repair_target
+          expr <- runJustParseExpr cc' r_prog
+          let (holes, holey) = unzip $ sanctifyExpr expr
+              filled = mapMaybe (`fillHole` undefVar) holey
+          length filled @?= 7
+          all (uncurry (==)) (zip holes (map fst filled)) @? "All fillings should match holes!"
     ]
 
 moduleTests =