diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index c55873409..1daf4fd62 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/src/GF/Compile/CheckGrammar.hs @@ -697,16 +697,26 @@ pattContext env typ p = case p of g <- pattContext env typ p return $ (x,typ):g - PAlt p q -> do - g1 <- pattContext env typ p + PAlt p' q -> do + g1 <- pattContext env typ p' g2 <- pattContext env typ q - return $ filter (flip elem g1) g2 -- must be in both + let pts = [pt | pt <- g1, notElem pt g2] ++ [pt | pt <- g2, notElem pt g1] + checkCond + ("incompatible bindings of" +++ + unwords (nub (map (prt . fst) pts))+++ + "in pattern alterantives" +++ prt p) (null pts) + return g1 -- must be g1 == g2 PSeq p q -> do g1 <- pattContext env typ p g2 <- pattContext env typ q return $ g1 ++ g2 - PRep p -> pattContext env typeStr p - PNeg p -> pattContext env typeStr p + PRep p' -> do + co <- pattContext env typeStr p' + if not (null co) + then checkWarn ("no variable bound inside * pattern" +++ prt p) + >> return [] + else return [] + PNeg p' -> pattContext env typ p' _ -> return [] ---- check types! where diff --git a/src/GF/Grammar/PatternMatch.hs b/src/GF/Grammar/PatternMatch.hs index c7205dcaf..7635e6fa1 100644 --- a/src/GF/Grammar/PatternMatch.hs +++ b/src/GF/Grammar/PatternMatch.hs @@ -105,9 +105,10 @@ tryMatch (p,t) = do return (concat matches) (PRep p1, ([],K s, [])) -> checks [ - trym (foldr (const (PSeq p1)) (PString "") [1..n]) t' | n <- [0 .. length s] - ] - + trym (foldr (const (PSeq p1)) (PString "") + [1..n]) t' | n <- [0 .. length s] + ] >> + return [] _ -> prtBad "no match in case expr for" t isInConstantForm :: Term -> Bool