diff --git a/src/compiler/GF/Compile/GrammarToCanonical.hs b/src/compiler/GF/Compile/GrammarToCanonical.hs index b19a0ba44..eea42eac1 100644 --- a/src/compiler/GF/Compile/GrammarToCanonical.hs +++ b/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,ident2raw,rawIdentS,showIdent,isWildIdent) +import GF.Infra.Ident(ModuleName(..),Ident,identW,ident2raw,rawIdentS,showIdent) 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 diff --git a/src/compiler/GF/Compile/Rename.hs b/src/compiler/GF/Compile/Rename.hs index 46d2e8b9e..cbb8a52ff 100644 --- a/src/compiler/GF/Compile/Rename.hs +++ b/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' diff --git a/src/compiler/GF/Compile/TypeCheck/Concrete.hs b/src/compiler/GF/Compile/TypeCheck/Concrete.hs index 6441ee516..9cc39f7eb 100644 --- a/src/compiler/GF/Compile/TypeCheck/Concrete.hs +++ b/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' diff --git a/src/compiler/GF/Grammar/Binary.hs b/src/compiler/GF/Grammar/Binary.hs index bba7e9f82..df9120b53 100644 --- a/src/compiler/GF/Grammar/Binary.hs +++ 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 diff --git a/src/compiler/GF/Grammar/Parser.y b/src/compiler/GF/Grammar/Parser.y index 678920c36..7499f1074 100644 --- a/src/compiler/GF/Grammar/Parser.y +++ b/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") diff --git a/src/compiler/GF/Infra/Ident.hs b/src/compiler/GF/Infra/Ident.hs index 7bd01c721..418eac980 100644 --- a/src/compiler/GF/Infra/Ident.hs +++ b/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 -isWildIdent x = case x of - IW -> True - IC s | s == wild -> True - _ -> False - -wild = Id (pack "_") +wild = pack "_" varIndex :: Ident -> Int varIndex (IV _ n) = n