More general catch-all pattern testing

tilk · Sep 28, 2022 · 82047d4 · 82047d4
1 parent 18a1a55
commit 82047d4
Showing 1 changed file with 11 additions and 1 deletion.
diff --git a/src/FSM/LangParser.hs b/src/FSM/LangParser.hs
@@ -276,9 +276,19 @@ parseCase = do
     return $ SCase e (addWildP cs)
 
 addWildP :: [(TH.Pat, Stmt LvlSugared)] -> [(TH.Pat, Stmt LvlSugared)]
-addWildP cs | TH.WildP `elem` map fst cs = cs
+addWildP cs | any isCatchAllPat (map fst cs) = cs
             | otherwise = cs ++ [(TH.WildP, SNop)]
 
+isCatchAllPat :: TH.Pat -> Bool
+isCatchAllPat TH.WildP = True
+isCatchAllPat (TH.VarP _) = True
+isCatchAllPat (TH.TildeP _) = True
+isCatchAllPat (TH.ParensP p) = isCatchAllPat p
+isCatchAllPat (TH.BangP p) = isCatchAllPat p
+isCatchAllPat (TH.AsP _ p) = isCatchAllPat p
+isCatchAllPat (TH.SigP p _) = isCatchAllPat p
+isCatchAllPat _ = False
+
 parseNop :: Parser (Stmt LvlSugared)
 parseNop = singleSymbol "skip" *> return SNop