a bit more refactoring

src/compiler/GF/Compile/GrammarToCanonical.hs

@@ -15,8 +15,7 @@ import GF.Grammar.Lookup(lookupOrigInfo,allOrigInfos,allParamValues)
 import GF.Grammar.Macros(typeForm,collectOp,collectPattOp,composSafeOp,mkAbs,mkApp,term2patt,sortRec)
 import GF.Grammar.Lockfield(isLockLabel)
 import GF.Grammar.Predef(cPredef,cInts)
--- import GF.Compile.Compute.Value(Predefined(..))
+import GF.Infra.Ident(ModuleName(..),Ident,identW,ident2raw,rawIdentS,showIdent)
-import GF.Infra.Ident(ModuleName(..),Ident,ident2raw,rawIdentS,showIdent,isWildIdent)
 import GF.Infra.Option(Options,optionsPGF)
 import GF.Infra.CheckM
 import PGF2(Literal(..))
@@ -399,7 +398,7 @@ class FromIdent i where
   gId :: Ident -> i
 
 instance FromIdent VarId where
-  gId i = if isWildIdent i then Anonymous else VarId (ident2raw i)
+  gId i = if i == identW then Anonymous else VarId (ident2raw i)
 
 instance FromIdent C.FunId where gId = C.FunId . ident2raw
 instance FromIdent CatId where gId = CatId . ident2raw

src/compiler/GF/Compile/Rename.hs

@@ -332,7 +332,7 @@ renameContext :: Status -> Context -> Check Context
 renameContext b = renc [] where
   renc vs cont = case cont of
     (bt,x,t) : xts
-      | isWildIdent x -> do
+      | x == identW -> do
           t'   <- ren vs t
           xts' <- renc vs xts
           return $ (bt,x,t') : xts'

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

@@ -125,7 +125,7 @@ inferLType gr g trm = case trm of
          case fty' of
            Prod bt z arg val -> do
              a' <- justCheck g a arg
-             ty <- if isWildIdent z
+             ty <- if z == identW
                       then return val
                       else substituteLType [(bt,z,a')] val
              return (App f' a',ty)
@@ -472,7 +472,7 @@ checkLType gr g trm typ0 = do
     Abs bt x c -> do
       case typ of
         Prod bt' z a b -> do
-          (c',b') <- if isWildIdent z
+          (c',b') <- if z == identW
                        then checkLType gr ((bt,x,a):g) c b
                        else do b' <- checkIn (pp "abs") $ substituteLType [(bt',z,Vr x)] b
                                checkLType gr ((bt,x,a):g) c b'

src/compiler/GF/Grammar/Binary.hs

@@ -28,17 +28,6 @@ import PGF2.Transactions(Symbol(..))
 -- Please change this every time when the GFO format is changed
 gfoVersion = "GF05"
 
-instance Binary Ident where
-  put id = put (ident2utf8 id)
-  get    = do bs <- get
-              if bs == BS.pack "_"
-                then return identW
-                else return (identC (rawIdentC bs))
-
-instance Binary ModuleName where
-  put (MN id) = put id
-  get = fmap MN get
-
 instance Binary Grammar where
   put = put . modules
   get = fmap mGrammar get

src/compiler/GF/Grammar/Parser.y

@@ -727,7 +727,7 @@ listCatDef (L loc (id,cont,size)) = [catd,nilfund,consfund]
     niltyp  = mkProdSimple (cont' ++ replicate size cd) lc
     constyp = mkProdSimple (cont' ++ [cd, mkHypo lc]) lc
 
-    mkId x i = if isWildIdent x then (varX i) else x
+    mkId x i = if x == identW then (varX i) else x
 
 tryLoc (c,mty,Just e) = return (c,(mty,e))
 tryLoc (c,_  ,_     ) = fail ("local definition of" +++ showIdent c +++ "without value")

src/compiler/GF/Infra/Ident.hs

@@ -19,7 +19,7 @@ module GF.Infra.Ident (-- ** Identifiers
   identS, identC, identW,
   -- *** Special identifiers for internal use
   identV,
-  varStr, varX, isWildIdent, varIndex,
+  varStr, varX, varIndex,
   -- *** Raw identifiers
   RawIdent, rawIdentS, rawIdentC, ident2raw, prefixRawIdent,
   isPrefixOf, showRawIdent
@@ -42,6 +42,9 @@ moduleNameS = MN . identS
 instance Show ModuleName where showsPrec d (MN m) = showsPrec d m
 instance Pretty ModuleName where pp (MN m) = pp m
 
+instance Binary ModuleName where
+  put (MN id) = put id
+  get = fmap MN get
 
 -- | the constructors labelled /INTERNAL/ are
 -- internal representation never returned by the parser
@@ -69,6 +72,13 @@ showRawIdent = unpack . rawId2utf8
 prefixRawIdent (Id x) (Id y) = Id (BS.append x y)
 isPrefixOf (Id x) (Id y) = BS.isPrefixOf x y
 
+instance Binary Ident where
+  put id = put (ident2utf8 id)
+  get    = do bs <- get
+              if bs == wild
+                then return identW
+                else return (identC (rawIdentC bs))
+
 instance Binary RawIdent where
   put = put . rawId2utf8
   get = fmap rawIdentC get
@@ -79,7 +89,7 @@ ident2utf8 :: Ident -> UTF8.ByteString
 ident2utf8 i = case i of
   IC (Id s) -> s
   IV (Id s) n -> BS.append s (pack ('_':show n))
-  IW -> pack "_"
+  IW -> wild
 
 ident2raw :: Ident -> RawIdent
 ident2raw = Id . ident2utf8
@@ -113,13 +123,7 @@ varStr = identS "str"
 varX :: Int -> Ident
 varX = identV (rawIdentS "x")
 
-isWildIdent :: Ident -> Bool
+wild = pack "_"
-isWildIdent x = case x of
-  IW -> True
-  IC s | s == wild -> True
-  _ -> False
-
-wild = Id (pack "_")
 
 varIndex :: Ident -> Int
 varIndex (IV _ n) = n