1 files changed, 75 insertions, 71 deletions
diff --git a/src/compiler/GF/Compile/Rename.hs b/src/compiler/GF/Compile/Rename.hs
index 9e959c353..6031ab938 100644
--- a/src/compiler/GF/Compile/Rename.hs
+++ b/src/compiler/GF/Compile/Rename.hs
@@ -39,7 +39,7 @@ import GF.Grammar.Printer
 import GF.Data.Operations
 
 import Control.Monad
-import Data.List (nub)
+import Data.List (nub,(\\))
 import Text.PrettyPrint
 
 -- | this gives top-level access to renaming term input in the cc command
@@ -235,76 +235,80 @@ renameTerm env vars = ren vars where
 
 -- | vars not needed in env, since patterns always overshadow old vars
 renamePattern :: Status -> Patt -> Check (Patt,[Ident])
-renamePattern env patt = case patt of
-
-  PMacro c -> do
-    c' <- renid $ Vr c
-    case c' of
-      Q d -> renp $ PM d
-      _ -> checkError (text "unresolved pattern" <+> ppPatt Unqualified 0 patt)
-
-  PC c ps -> do
-    c' <- renid $ Cn c
-    case c' of
-      QC c -> do psvss <- mapM renp ps
-                 let (ps,vs) = unzip psvss
-                 return (PP c ps, concat vs)
-      Q  _ -> checkError (text "data constructor expected but" <+> ppTerm Qualified 0 c' <+> text "is found instead")
-      _    -> checkError (text "unresolved data constructor" <+> ppTerm Qualified 0 c')
-
-  PP c ps -> do
-    (QC c') <- renid (QC c)
-    psvss <- mapM renp ps
-    let (ps',vs) = unzip psvss
-    return (PP c' ps', concat vs)
-
-  PM c -> do
-    x <- renid (Q c)
-    c' <- case x of
-            (Q c') -> return c'
-            _      -> checkError (text "not a pattern macro" <+> ppPatt Qualified 0 patt)
-    return (PM c', [])
-
-  PV x -> checks [ renid' (Vr x) >>= \t' -> case t' of
-                                             QC c -> return (PP c [],[])
-                                             _    -> checkError (text "not a constructor")
-                 , return (patt, [x])
-                 ]
-
-  PR r -> do
-    let (ls,ps) = unzip r
-    psvss <- mapM renp ps
-    let (ps',vs') = unzip psvss
-    return (PR (zip ls ps'), concat vs') 
-
-  PAlt p q -> do
-    (p',vs) <- renp p
-    (q',ws) <- renp q
-    return (PAlt p' q', vs ++ ws)
-
-  PSeq p q -> do
-    (p',vs) <- renp p
-    (q',ws) <- renp q
-    return (PSeq p' q', vs ++ ws)
-
-  PRep p -> do
-    (p',vs) <- renp p
-    return (PRep p', vs)
-
-  PNeg p -> do
-    (p',vs) <- renp p
-    return (PNeg p', vs)
-
-  PAs x p -> do
-    (p',vs) <- renp p
-    return (PAs x p', x:vs)
-
-  _ -> return (patt,[])
-
- where 
-   renp  = renamePattern env
-   renid = renameIdentTerm env
-   renid' = renameIdentTerm' env
+renamePattern env patt =
+    do r@(p',vs) <- renp patt
+       let dupl = vs \\ nub vs
+       unless (null dupl) $ checkError (hang (text "[C.4.13] Pattern is not linear:") 4
+                                             (ppPatt Unqualified 0 patt))
+       return r
+  where
+    renp patt = case patt of
+      PMacro c -> do
+        c' <- renid $ Vr c
+        case c' of
+          Q d -> renp $ PM d
+          _ -> checkError (text "unresolved pattern" <+> ppPatt Unqualified 0 patt)
+
+      PC c ps -> do
+        c' <- renid $ Cn c
+        case c' of
+          QC c -> do psvss <- mapM renp ps
+                     let (ps,vs) = unzip psvss
+                     return (PP c ps, concat vs)
+          Q  _ -> checkError (text "data constructor expected but" <+> ppTerm Qualified 0 c' <+> text "is found instead")
+          _    -> checkError (text "unresolved data constructor" <+> ppTerm Qualified 0 c')
+
+      PP c ps -> do
+        (QC c') <- renid (QC c)
+        psvss <- mapM renp ps
+        let (ps',vs) = unzip psvss
+        return (PP c' ps', concat vs)
+
+      PM c -> do
+        x <- renid (Q c)
+        c' <- case x of
+                (Q c') -> return c'
+                _      -> checkError (text "not a pattern macro" <+> ppPatt Qualified 0 patt)
+        return (PM c', [])
+
+      PV x -> checks [ renid' (Vr x) >>= \t' -> case t' of
+                                                 QC c -> return (PP c [],[])
+                                                 _    -> checkError (text "not a constructor")
+                     , return (patt, [x])
+                     ]
+
+      PR r -> do
+        let (ls,ps) = unzip r
+        psvss <- mapM renp ps
+        let (ps',vs') = unzip psvss
+        return (PR (zip ls ps'), concat vs')
+
+      PAlt p q -> do
+        (p',vs) <- renp p
+        (q',ws) <- renp q
+        return (PAlt p' q', vs ++ ws)
+
+      PSeq p q -> do
+        (p',vs) <- renp p
+        (q',ws) <- renp q
+        return (PSeq p' q', vs ++ ws)
+
+      PRep p -> do
+        (p',vs) <- renp p
+        return (PRep p', vs)
+
+      PNeg p -> do
+        (p',vs) <- renp p
+        return (PNeg p', vs)
+
+      PAs x p -> do
+        (p',vs) <- renp p
+        return (PAs x p', x:vs)
+
+      _ -> return (patt,[])
+
+    renid = renameIdentTerm env
+    renid' = renameIdentTerm' env
 
 renameContext :: Status -> Context -> Check Context
 renameContext b = renc [] where