summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/GF/Compile/Rename.hs21
-rw-r--r--testsuite/compiler/renamer/funpatt.gf14
-rw-r--r--testsuite/compiler/renamer/funpatt.gfs1
-rw-r--r--testsuite/compiler/renamer/funpatt.gfs.gold7
-rw-r--r--testsuite/compiler/renamer/varpatt.gf13
-rw-r--r--testsuite/compiler/renamer/varpatt.gfs4
-rw-r--r--testsuite/compiler/renamer/varpatt.gfs.gold4
7 files changed, 55 insertions, 9 deletions
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
+