diff --git a/src/GF/Compile/Rename.hs b/src/GF/Compile/Rename.hs index 05ccfdb2c..c00e31d95 100644 --- a/src/GF/Compile/Rename.hs +++ b/src/GF/Compile/Rename.hs @@ -36,11 +36,13 @@ import GF.Grammar.Macros import GF.Grammar.PrGrammar import GF.Grammar.AppPredefined import GF.Grammar.Lookup +import GF.Grammar.Printer import GF.Data.Operations import Control.Monad import Data.List (nub) import Debug.Trace (trace) +import Text.PrettyPrint renameGrammar :: SourceGrammar -> Err SourceGrammar renameGrammar g = liftM (MGrammar . reverse) $ foldM renameModule [] (modules g) @@ -236,15 +238,15 @@ renamePattern env patt = case patt of _ -> prtBad "unresolved pattern" patt PC c ps -> do - c' <- renameIdentTerm env $ Cn c + c' <- renid $ Cn c case c' of - QC p d -> renp $ PP p d ps --- Q p d -> renp $ PP p d ps --- why this? AR 15/3/2008 - _ -> prtBad "unresolved pattern" c' ---- (PC c ps', concat vs) + QC m c -> renp $ PP m c ps + Q _ _ -> Bad $ render (text "data constructor expected but" <+> ppTerm Qualified 0 c' <+> text "is found instead") + _ -> Bad $ render (text "unresolved data constructor" <+> ppTerm Qualified 0 c') PP p c ps -> do - (p', c') <- case renameIdentTerm env (QC p c) of + (p', c') <- case renid (QC p c) of Ok (QC p' c') -> return (p',c') _ -> return (p,c) --- temporarily, for bw compat psvss <- mapM renp ps @@ -252,14 +254,15 @@ renamePattern env patt = case patt of return (PP p' c' ps', concat vs) PM p c -> do - (p', c') <- case renameIdentTerm env (Q p c) of + (p', c') <- case renid (Q p c) of Ok (Q p' c') -> return (p',c') _ -> prtBad "not a pattern macro" patt return (PM p' c', []) - PV x -> case renid (Vr x) of - Ok (QC m c) -> return (PP m c [],[]) - _ -> return (patt, [x]) + PV x -> do case renid (Vr x) of + Ok (QC m c) -> return (PP m c [],[]) + Ok (Q m c) -> Bad $ render (text "data constructor expected but" <+> ppTerm Qualified 0 (Q m c) <+> text "is found instead") + _ -> return (patt, [x]) PR r -> do let (ls,ps) = unzip r diff --git a/testsuite/compiler/renamer/funpatt.gf b/testsuite/compiler/renamer/funpatt.gf new file mode 100644 index 000000000..8406e1e3b --- /dev/null +++ b/testsuite/compiler/renamer/funpatt.gf @@ -0,0 +1,14 @@ +abstract funpatt = { + +-- this should raise error +-- we cannot pattern match on functions + +cat D ; +fun D1 : D ; + D2 : D ; + +fun d : D -> Int ; +def d D1 = 1 ; + d D2 = 2 ; + +} \ No newline at end of file diff --git a/testsuite/compiler/renamer/funpatt.gfs b/testsuite/compiler/renamer/funpatt.gfs new file mode 100644 index 000000000..c7692083e --- /dev/null +++ b/testsuite/compiler/renamer/funpatt.gfs @@ -0,0 +1 @@ +i -src testsuite/compiler/renamer/funpatt.gf diff --git a/testsuite/compiler/renamer/funpatt.gfs.gold b/testsuite/compiler/renamer/funpatt.gfs.gold new file mode 100644 index 000000000..b64278900 --- /dev/null +++ b/testsuite/compiler/renamer/funpatt.gfs.gold @@ -0,0 +1,7 @@ + + +data constructor expected but funpatt.D1 is found instead +OCCURRED IN +renaming definition of d in funpatt.gf, line 12 +OCCURRED IN +renaming module funpatt diff --git a/testsuite/compiler/renamer/varpatt.gf b/testsuite/compiler/renamer/varpatt.gf new file mode 100644 index 000000000..93bddd63e --- /dev/null +++ b/testsuite/compiler/renamer/varpatt.gf @@ -0,0 +1,13 @@ +abstract varpatt = { + +-- this should raise error +-- we cannot pattern match on functions + +cat D ; +fun D1 : D ; + D2 : D ; + +fun d : D -> Int ; +def d x = 1 ; + +} \ No newline at end of file diff --git a/testsuite/compiler/renamer/varpatt.gfs b/testsuite/compiler/renamer/varpatt.gfs new file mode 100644 index 000000000..f3422103e --- /dev/null +++ b/testsuite/compiler/renamer/varpatt.gfs @@ -0,0 +1,4 @@ +i -src testsuite/compiler/renamer/varpatt.gf + +pt -compute d D1 +pt -compute d D2 diff --git a/testsuite/compiler/renamer/varpatt.gfs.gold b/testsuite/compiler/renamer/varpatt.gfs.gold new file mode 100644 index 000000000..8d4409e5d --- /dev/null +++ b/testsuite/compiler/renamer/varpatt.gfs.gold @@ -0,0 +1,4 @@ +1 + +1 +