deprecate PW in favour of PV identW

src/compiler/api/GF/Compile/Compute.hs

@@ -361,6 +361,7 @@ evalAbsDef g@(Gl gr pds _) c q args =
       case splitAt' arity args of
         Nothing -> VPAP c q args
         Just (_,_) -> patternMatch g c (VConst q args) (map (\(ps,t) -> ([],ps,args,t)) eqs)
+    Ok (_,Nothing) -> VConst q args
     Bad msg -> error msg
 
 apply g (VMeta i vs0)                   vs  = VMeta i   (vs0++vs)
@@ -550,9 +551,10 @@ patternMatch g s v0 ((env0,ps,args0,t):eqs) = match env0 ps eqs args0
                                                  Bad msg -> error msg
                                                where
                                                  Gl gr _ _ = g
-    match env (PV v      :ps) eqs (arg:args) = match ((v,arg):env) ps eqs args
+    match env (PV v      :ps) eqs (arg:args)
+      | v == identW                          = match          env  ps eqs args
+      | otherwise                            = match ((v,arg):env) ps eqs args
     match env (PAs v p   :ps) eqs (arg:args) = match ((v,arg):env) (p:ps) eqs (arg:args)
-    match env (PW        :ps) eqs (arg:args) = match env ps eqs args
     match env (PTilde _  :ps) eqs (arg:args) = match env ps eqs args
     match env (p         :ps) eqs (arg:args) = match' env p ps eqs arg args
 

src/compiler/api/GF/Compile/ConcreteToHaskell.hs

@@ -170,8 +170,9 @@ concrete2haskell opts abstr@(absname,_) concr@(cncname,mi) =
 
     convertPatt (PC c     ps) = ConP (gId c) (map convertPatt ps)
     convertPatt (PP (_,c) ps) = ConP (gId c) (map convertPatt ps)
-    convertPatt (PV v)        = VarP v
+    convertPatt (PV v)
-    convertPatt PW            = WildP
+      | v == identW           = WildP
+      | otherwise             = VarP v
     convertPatt (PR lbls)     = ConP (rcon' ls) (map convertPatt ps)
       where (ls,ps) = unzip $ sortOn fst lbls
     convertPatt (PString s)   = Lit s

src/compiler/api/GF/Compile/GenerateBC.hs

@@ -50,8 +50,9 @@ compileEquations gr arity st (i:is) eqs       fl bs = whilePP eqs Map.empty
                                                              in (bs3,[PUSH_FRAME, EVAL (shiftIVal (st+2) i) RecCall] ++ instrs1)
 
     whilePV []                           vrs = compileEquations gr arity st is vrs fl bs
-    whilePV ((vs, PV x     : ps, t):eqs) vrs = whilePV eqs (((x,i):vs,ps,t) : vrs)
+    whilePV ((vs, PV x     : ps, t):eqs) vrs
-    whilePV ((vs, PW       : ps, t):eqs) vrs = whilePV eqs ((      vs,ps,t) : vrs)
+      | x == identW                          = whilePV eqs ((      vs,ps,t) : vrs)
+      | otherwise                            = whilePV eqs (((x,i):vs,ps,t) : vrs)
     whilePV ((vs, PTilde _ : ps, t):eqs) vrs = whilePV eqs ((      vs,ps,t) : vrs)
     whilePV ((vs, PImplArg p:ps, t):eqs) vrs = whilePV ((vs,p:ps,t):eqs) vrs
     whilePV ((vs, PT _ p   : ps, t):eqs) vrs = whilePV ((vs,p:ps,t):eqs) vrs

src/compiler/api/GF/Compile/GeneratePMCFG.hs

@@ -169,7 +169,7 @@ type2metaTerm gr d ms s r rs (RecType lbls) params =
   in (ms',s',r',R ass,params')
 type2metaTerm gr d ms s r rs (Table p q) params
   | count == 1 = let (ms',s',r',t,params') = type2metaTerm gr d ms s r rs q params
-                 in (ms',s',r+(r'-r),T (TTyped p) [(PW,t)],params')
+                 in (ms',s',r+(r'-r),T (TTyped p) [(PV identW,t)],params')
   | otherwise  = let pv     = varX (length rs+1)
                      (ms',s',r',t,params') = type2metaTerm gr d ms s r ((delta,(pv,p)):rs) q params
                      delta  = r'-r

src/compiler/api/GF/Compile/GrammarToPGF.hs

@@ -153,7 +153,6 @@ mkPatt scope p =
     A.PV x      -> (x:scope,C.PVar (i2i x))
     A.PAs x p   -> let (scope',p') = mkPatt scope p
                    in (x:scope',C.PAs (i2i x) p')
-    A.PW        -> (  scope,C.PWild)
     A.PInt i    -> (  scope,C.PLit (C.LInt (fromIntegral i)))
     A.PFloat f  -> (  scope,C.PLit (C.LFlt f))
     A.PString s -> (  scope,C.PLit (C.LStr s))

src/compiler/api/GF/Compile/TypeCheck.hs

@@ -98,7 +98,6 @@ checkDef g q ty (ps,t) = do
                               (scope,arg_ty) <- tcPatt scope c1 p (Just arg_ty)
                               go scope c2 res_ty ps
 
-  -- tcPatt scope c PW        Nothing    = do
 
 inferSigma :: Scope -> Choice -> Term -> EvalM (Term,Sigma)
 inferSigma scope s t = do                                      -- GEN1
@@ -766,17 +765,16 @@ reapply2 scope c fun fun_ty ((arg,arg_v,arg_ty):args) mb_ty = do -- Explicit arg
   res_ty <- evalCodomain x arg_v res_ty
   reapply2 scope c (App fun arg) res_ty args mb_ty
 
-tcPatt scope c PW        Nothing    = do
-  i <- newResiduation scope
-  return (scope,VMeta i [])
-tcPatt scope c PW        (Just ty0) =
-  return (scope,ty0)
 tcPatt scope c (PV x)    Nothing    = do
   i <- newResiduation scope
-  let ty = VMeta i []
+  if x == identW
-  return ((x,ty):scope,ty)
+    then return (scope,VMeta i [])
+    else let ty = VMeta i []
+         in return ((x,ty):scope,ty)
 tcPatt scope c (PV x)    (Just ty) =
-  return ((x,ty):scope,ty)
+  if x == identW
+    then return (scope,ty)
+    else return ((x,ty):scope,ty)
 tcPatt scope c (PP q ps) mb_ty = do
   g@(Gl gr _ isAbstract) <- globals
   ty <- case (if isAbstract then lookupFunType else lookupResType) gr q of
@@ -923,7 +921,8 @@ measurePatt p =
                      return (min,max,PT t p')
     PAs x p    -> do (min,max,p) <- measurePatt p
                      case p of
-                       PW -> return (0,Nothing,PV x)
+                       PV y | y == identW
+                          -> return (0,Nothing,PV x)
                        _  -> return (min,max,PAs x p)
     PImplArg p -> do (min,max,p') <- measurePatt p
                      return (min,max,PImplArg p')
@@ -941,13 +940,16 @@ measurePatt p =
                -> do (min1,max1,p1) <- measurePatt p1
                      (min2,max2,p2) <- measurePatt p2
                      case (p1,p2) of
-                       (PW,        PW        ) -> return (0,Nothing,PW)
+                       (PV x,      PV y      )
+                         | x == identW && y == identW
+                                               -> return (0,Nothing,PV identW)
                        (PString s1,PString s2) -> return (min1+min2,liftM2 (+) max1 max2,PString (s1++s2))
                        _                       -> return (min1+min2,liftM2 (+) max1 max2,PSeq min1 max1 p1 min2 max2 p2)
     PRep _ _ p -> do (minp,maxp,p) <- measurePatt p
                      case p of
-                       PW    -> return (0,Nothing,PW)
+                       PV x | x == identW
-                       PChar -> return (0,Nothing,PW)
+                             -> return (0,Nothing,PV x)
+                       PChar -> return (0,Nothing,PV identW)
                        _     -> return (0,Nothing,PRep minp maxp p)
     PChar      -> return (1,Just 1,p)
     PChars _   -> return (1,Just 1,p)

src/compiler/api/GF/Grammar/Binary.hs

@@ -224,7 +224,6 @@ instance Binary Patt where
   put (PC x y)     = putWord8  0 >> put (x,y)
   put (PP x y)     = putWord8  1 >> put (x,y)
   put (PV x)       = putWord8  2 >> put x
-  put (PW)         = putWord8  3
   put (PR x)       = putWord8  4 >> put x
   put (PString x)  = putWord8  5 >> put x
   put (PInt    x)  = putWord8  6 >> put x
@@ -246,7 +245,6 @@ instance Binary Patt where
              0  -> get >>= \(x,y)   -> return (PC x y)
              1  -> get >>= \(x,y)   -> return (PP x y)
              2  -> get >>= \x       -> return (PV x)
-             3  ->                     return (PW)
              4  -> get >>= \x       -> return (PR x)
              5  -> get >>= \x       -> return (PString x)
              6  -> get >>= \x       -> return (PInt    x)

src/compiler/api/GF/Grammar/Grammar.hs

@@ -410,8 +410,7 @@ data Term =
 data Patt =
    PC Ident [Patt]        -- ^ constructor pattern: @C p1 ... pn@    @C@ 
  | PP QIdent [Patt]       -- ^ package constructor pattern: @P.C p1 ... pn@    @P.C@ 
- | PV Ident               -- ^ variable pattern: @x@
+ | PV Ident               -- ^ variable pattern: @x@ or wild card @_@
- | PW                     -- ^ wild card pattern: @_@
  | PR [(Label,Patt)]      -- ^ record pattern: @{r = p ; ...}@  -- only concrete
  | PString String         -- ^ string literal pattern: @\"foo\"@  -- only abstract
  | PInt    Integer        -- ^ integer literal pattern: @12@    -- only abstract

src/compiler/api/GF/Grammar/JSON.hs

@@ -198,7 +198,6 @@ json2term o  = Vr      <$> o!:"vr"
 patt2json (PC id ps)     = makeObj [("pc",showJSON id),("args",showJSON (map patt2json ps))]
 patt2json (PP (mn,id) ps) = makeObj [("mod",showJSON mn),("pc",showJSON id),("args",showJSON (map patt2json ps))]
 patt2json (PV id)        = makeObj [("pv",showJSON id)]
-patt2json PW             = makeObj [("wildcard",showJSON True)]
 patt2json (PR lbls)      = makeObj (("record", showJSON True) : map toRow lbls)
                                where toRow (l,t) = (showLabel l, patt2json t)
 patt2json (PString s)    = showJSON s
@@ -231,7 +230,6 @@ json2patt :: JSValue -> Result Patt
 json2patt o = PP <$> (liftM2 (\mn id -> (mn,id)) (o!:"mod") (o!:"pc")) <*> (o!:"args" >>= mapM json2patt)
     <|>       PC <$> (o!:"pc") <*> (o!:"args" >>= mapM json2patt)
     <|>       PV <$> (o!:"pv")
-    <|>  (o!:"wildcard" >>= guard >> return PW)
     <|> (const PR) <$> (o!:"record" >>= guard) <*> mapM fromRow (assocsJSObject o)
     <|>  PString <$> readJSON o
     <|>  PInt    <$> readJSON o

src/compiler/api/GF/Grammar/Parser.y

@@ -536,7 +536,7 @@ Patt3
   | '[' String ']'            { PChars $2 }
   | '#' Ident                 { PMacro $2 }
   | '#' ModuleName '.' Ident  { PM ($2,$4) }
-  | '_'                       { PW }
+  | '_'                       { PV identW }
   | Ident                     { PV $1 }
   | ModuleName '.' Ident      { PP ($1,$3) [] }
   | Integer                   { PInt $1 }

src/compiler/api/GF/Grammar/Printer.hs

@@ -293,7 +293,6 @@ ppPatt q d (PChar)      = pp '?'
 ppPatt q d (PChars s)   = brackets (str s)
 ppPatt q d (PMacro id)  = '#' <> id
 ppPatt q d (PM id)      = '#' <> ppQIdent q id
-ppPatt q d PW           = pp '_'
 ppPatt q d (PV id)      = pp id
 ppPatt q d (PInt n)     = pp n
 ppPatt q d (PFloat f)   = pp f
@@ -369,8 +368,6 @@ 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)