From a7900bfbc8e95053b161c6c1d50ada9c7859029a Mon Sep 17 00:00:00 2001
From: krasimir <krasimir@chalmers.se>
Date: Fri, 22 May 2009 21:47:32 +0000
Subject: [PATCH] fix the handling of wildcards

---
 src/GF/Compile/AbsCompute.hs     | 2 +-
 src/GF/Compile/CheckGrammar.hs   | 2 +-
 src/GF/Compile/Compute.hs        | 4 ++--
 src/GF/Grammar/PatternMatch.hs   | 4 ++--
 src/GF/Grammar/Printer.hs        | 3 +++
 src/GF/Source/GrammarToSource.hs | 1 -
 6 files changed, 9 insertions(+), 7 deletions(-)

diff --git a/src/GF/Compile/AbsCompute.hs b/src/GF/Compile/AbsCompute.hs
index ce3528b68..a4a8d803e 100644
--- a/src/GF/Compile/AbsCompute.hs
+++ b/src/GF/Compile/AbsCompute.hs
@@ -109,7 +109,7 @@ tryMatch (p,t) = do
 
   trym p t' = err (\s -> tracd s (Bad s)) (\t -> tracd (prtm p t) (return t)) $ ---- 
               case (p,t') of
-    (PV IW, _) | notMeta t -> return [] -- optimization with wildcard
+    (PW,    _) | notMeta t -> return [] -- optimization with wildcard
     (PV x,  _) | notMeta t -> return [(x,t)]
     (PString s, ([],K i,[])) | s==i -> return []
     (PInt s, ([],EInt i,[])) | s==i -> return []
diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs
index 59961e0cd..bad6bcbcf 100644
--- a/src/GF/Compile/CheckGrammar.hs
+++ b/src/GF/Compile/CheckGrammar.hs
@@ -897,7 +897,7 @@ checkLType env trm typ0 = do
 
 pattContext :: LTEnv -> Type -> Patt -> Check Context
 pattContext env typ p = case p of
-  PV x | not (isWildIdent x) -> return [(x,typ)]
+  PV x -> return [(x,typ)]
   PP q c ps | q /= cPredef -> do ---- why this /=? AR 6/1/2006
     t <- checkErr $ lookupResType cnc q c
     (cont,v) <- checkErr $ typeFormCnc t
diff --git a/src/GF/Compile/Compute.hs b/src/GF/Compile/Compute.hs
index dc7b51071..126575946 100644
--- a/src/GF/Compile/Compute.hs
+++ b/src/GF/Compile/Compute.hs
@@ -300,8 +300,8 @@ computeTermOpt rec gr = comput True where
        _ -> case t' of
          FV ccs -> mapM (\c -> comp g (S c v')) ccs >>= returnC . variants
 
-         T _ [(PV IW,c)] -> comp g c           --- an optimization
-         T _ [(PT _ (PV IW),c)] -> comp g c
+         T _ [(PW,c)] -> comp g c           --- an optimization
+         T _ [(PT _ PW,c)] -> comp g c
 
          T _ [(PV z,c)] -> comp (ext z v' g) c --- another optimization
          T _ [(PT _ (PV z),c)] -> comp (ext z v' g) c
diff --git a/src/GF/Grammar/PatternMatch.hs b/src/GF/Grammar/PatternMatch.hs
index 021735c79..a14b405f3 100644
--- a/src/GF/Grammar/PatternMatch.hs
+++ b/src/GF/Grammar/PatternMatch.hs
@@ -82,7 +82,7 @@ tryMatch (p,t) = do
       (PVal pa _ _,_) -> trym pa t'
       (_, (_,Val te _ _,_)) -> tryMatch (p, te)
       (_,(x,Empty,y)) -> trym p (x,K [],y)   -- because "" = [""] = []
-      (PV IW, _) | isInConstantFormt -> return [] -- optimization with wildcard
+      (PW, _) | isInConstantFormt -> return [] -- optimization with wildcard
       (PV x,  _) | isInConstantFormt -> return [(x,t)]
       (PString s, ([],K i,[])) | s==i -> return []
       (PInt s, ([],EInt i,[])) | s==i -> return []
@@ -159,7 +159,7 @@ isInConstantForm trm = case trm of
 
 varsOfPatt :: Patt -> [Ident]
 varsOfPatt p = case p of
-  PV x -> [x | not (isWildIdent x)]
+  PV x -> [x]
   PC _ ps -> concat $ map varsOfPatt ps
   PP _ _ ps -> concat $ map varsOfPatt ps
   PR r    -> concat $ map (varsOfPatt . snd) r
diff --git a/src/GF/Grammar/Printer.hs b/src/GF/Grammar/Printer.hs
index b658cc9d1..383d36d4f 100644
--- a/src/GF/Grammar/Printer.hs
+++ b/src/GF/Grammar/Printer.hs
@@ -218,6 +218,7 @@ ppPatt q d (PChar)      = char '?'
 ppPatt q d (PChars s)   = brackets (text (show s))
 ppPatt q d (PMacro id)  = char '#' <> ppIdent id
 ppPatt q d (PM m id)    = char '#' <> ppIdent m <> char '.' <> ppIdent id
+ppPatt q d PW           = char '_'
 ppPatt q d (PV id)      = ppIdent id
 ppPatt q d (PInt n)     = integer n
 ppPatt q d (PFloat f)   = double f
@@ -269,6 +270,8 @@ getAbs e         = ([],e)
 getCTable :: Term -> ([Ident], Term)
 getCTable (T TRaw [(PV v,e)]) = let (vs,e') = getCTable e
                                 in (v:vs,e')
+getCTable (T TRaw [(PW,  e)]) = let (vs,e') = getCTable e
+                                in (identW:vs,e')
 getCTable e                   = ([],e)
 
 getLet :: Term -> ([LocalDef], Term)
diff --git a/src/GF/Source/GrammarToSource.hs b/src/GF/Source/GrammarToSource.hs
index e15193550..cff23f426 100644
--- a/src/GF/Source/GrammarToSource.hs
+++ b/src/GF/Source/GrammarToSource.hs
@@ -182,7 +182,6 @@ trt trm = case trm of
 trp :: Patt -> P.Patt
 trp p = case p of
     PW -> P.PW
-    PV s | isWildIdent s -> P.PW
     PV s -> P.PV $ tri s
     PC c [] -> P.PCon $ tri c
     PC c a -> P.PC (tri c) (map trp a)