on master help sign in
Fix pattern matching aliases so that it works in all cases. Previously it was totally broken.
da9c493Evan Czaplicki
compiler/Generate/Cases.hs+14−8
@@ -43,7 +43,7 @@ matchSubst pairs (Match n cs m) =
43 clauseSubst (Clause c vs m) =
43 clauseSubst (Clause c vs m) =
44 Clause c (map varSubst vs) (matchSubst pairs m)
44 Clause c (map varSubst vs) (matchSubst pairs m)
45
45
46−isCon (p:ps, _) =
46+isCon (p:ps, e) =
47 case p of
47 case p of
48 PData _ _ -> True
48 PData _ _ -> True
49 PLiteral _ -> True
49 PLiteral _ -> True
@@ -56,22 +56,28 @@ match [] [] def = return def
56match [] [([],e)] Fail = return $ Other e
56match [] [([],e)] Fail = return $ Other e
57match [] [([],e)] Break = return $ Other e
57match [] [([],e)] Break = return $ Other e
58match [] cs def = return $ Seq (map (Other . snd) cs ++ [def])
58match [] cs def = return $ Seq (map (Other . snd) cs ++ [def])
59−match vs cs def
59+match vs@(v:_) cs def
60− | all isVar cs = matchVar vs cs def
60+ | all isVar cs' = matchVar vs cs' def
61− | all isCon cs = matchCon vs cs def
61+ | all isCon cs' = matchCon vs cs' def
62− | otherwise = matchMix vs cs def
62+ | otherwise = matchMix vs cs' def
63+ where
64+ cs' = map (dealias v) cs
65+
66+dealias v c@(p:ps, L t s e) =
67+ case p of
68+ PAlias x pattern -> (pattern:ps, L t s $ subst x (Var v) e)
69+ _ -> c
63
70
64matchVar :: [String] -> [([Pattern],LExpr t v)] -> Match t v
71matchVar :: [String] -> [([Pattern],LExpr t v)] -> Match t v
65 -> Unique (Match t v)
72 -> Unique (Match t v)
66matchVar (v:vs) cs def = match vs (map subVar cs) def
73matchVar (v:vs) cs def = match vs (map subVar cs) def
67 where
74 where
68− subVar (p:ps, ce@(L t s e)) = (ps, L t s $ subOnePattern p)
75+ subVar (p:ps, ce@(L t s e)) = (ps, L t s $ subOnePattern p e)
69 where
76 where
70 loc = L t s
77 loc = L t s
71− subOnePattern pattern =
78+ subOnePattern pattern e =
72 case pattern of
79 case pattern of
73 PVar x -> subst x (Var v) e
80 PVar x -> subst x (Var v) e
74− PAlias x p -> subst x (Var v) e
75 PAnything -> e
81 PAnything -> e
76 PRecord fs ->
82 PRecord fs ->
77 foldr (\x -> subst x (Access (loc (Var v)) x)) e fs
83 foldr (\x -> subst x (Access (loc (Var v)) x)) e fs