From 3d5b9bd1fd46a51651cbfbd45f03e5b878aebbac Mon Sep 17 00:00:00 2001 From: hallgren Date: Thu, 19 Sep 2013 18:23:47 +0000 Subject: Make Ident abstract; imports of Data.ByteString.Char8 down from 29 to 16 modules Most of the explicit uses of ByteStrings were eliminated by using identS, identS = identC . BS.pack which was found in GF.Grammar.CF and moved to GF.Infra.Ident. The function prefixIdent :: String -> Ident -> Ident allowed one additional import of ByteString to be eliminated. The functions isArgIdent :: Ident -> Bool getArgIndex :: Ident -> Maybe Int were needed to eliminate explicit pattern matching on Ident from two modules. --- src/compiler/GF/Compile/Compute/AppPredefined.hs | 12 ++++-------- src/compiler/GF/Compile/Compute/ConcreteLazy.hs | 3 +-- src/compiler/GF/Compile/Compute/ConcreteNew.hs | 5 ++--- src/compiler/GF/Compile/Compute/ConcreteNew1.hs | 3 +-- src/compiler/GF/Compile/GeneratePMCFG.hs | 7 ++----- src/compiler/GF/Compile/Optimize.hs | 3 +-- src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs | 7 +++---- src/compiler/GF/Compile/TypeCheck/TC.hs | 2 +- 8 files changed, 15 insertions(+), 27 deletions(-) (limited to 'src/compiler/GF/Compile') diff --git a/src/compiler/GF/Compile/Compute/AppPredefined.hs b/src/compiler/GF/Compile/Compute/AppPredefined.hs index d4b6dfb41..869052e0a 100644 --- a/src/compiler/GF/Compile/Compute/AppPredefined.hs +++ b/src/compiler/GF/Compile/Compute/AppPredefined.hs @@ -16,14 +16,13 @@ module GF.Compile.Compute.AppPredefined ( isInPredefined, typPredefined, arrityPredefined, predefModInfo, appPredefined ) where -import GF.Infra.Ident +import GF.Infra.Ident(identS) import GF.Infra.Option import GF.Data.Operations import GF.Grammar import GF.Grammar.Predef import qualified Data.Map as Map -import qualified Data.ByteString.Char8 as BS import Text.PrettyPrint import Data.Char (isUpper,toUpper,toLower) @@ -90,11 +89,8 @@ primitives = Map.fromList fun from to = oper (mkFunType from to) oper ty = ResOper (Just (noLoc ty)) Nothing - varL :: Ident - varL = identC (BS.pack "L") - - varP :: Ident - varP = identC (BS.pack "P") + varL = identS "L" + varP = identS "P" appPredefined :: Term -> Err (Term,Bool) appPredefined t = case t of @@ -127,7 +123,7 @@ appPredefined t = case t of (EInt i, EInt j) | f == cLessInt -> retb $ if i retb $ EInt $ i+j (_, t) | f == cShow && notVar t -> retb $ foldrC $ map K $ words $ render (ppTerm Unqualified 0 t) - (_, K s) | f == cRead -> retb $ Cn (identC (BS.pack s)) --- because of K, only works for atomic tags + (_, K s) | f == cRead -> retb $ Cn (identS s) --- because of K, only works for atomic tags (_, t) | f == cToStr -> trm2str t >>= retb _ -> retb t ---- prtBad "cannot compute predefined" t diff --git a/src/compiler/GF/Compile/Compute/ConcreteLazy.hs b/src/compiler/GF/Compile/Compute/ConcreteLazy.hs index fce118fec..0e3a4fb45 100644 --- a/src/compiler/GF/Compile/Compute/ConcreteLazy.hs +++ b/src/compiler/GF/Compile/Compute/ConcreteLazy.hs @@ -508,8 +508,7 @@ computeTermOpt gr = comput True where -- | argument variables cannot be glued checkNoArgVars :: Term -> Comp Term checkNoArgVars t = case t of - Vr (IA _ _) -> fail $ glueErrorMsg $ ppTerm Unqualified 0 t - Vr (IAV _ _ _) -> fail $ glueErrorMsg $ ppTerm Unqualified 0 t + Vr x | isArgIdent x -> fail $ glueErrorMsg $ ppTerm Unqualified 0 t _ -> composOp checkNoArgVars t glueErrorMsg s = diff --git a/src/compiler/GF/Compile/Compute/ConcreteNew.hs b/src/compiler/GF/Compile/Compute/ConcreteNew.hs index 3a05d62fb..3e87ea43a 100644 --- a/src/compiler/GF/Compile/Compute/ConcreteNew.hs +++ b/src/compiler/GF/Compile/Compute/ConcreteNew.hs @@ -19,7 +19,6 @@ import Control.Monad(ap,liftM,liftM2,mplus,unless) import Data.List (findIndex,intersect,isInfixOf,nub,elemIndex,(\\)) import Data.Char (isUpper,toUpper,toLower) import Text.PrettyPrint -import qualified Data.ByteString.Char8 as BS import qualified Data.Map as Map --import Debug.Trace(trace) @@ -80,7 +79,7 @@ resource env (m,c) = resourceValues :: SourceGrammar -> GlobalEnv resourceValues gr = env where - env = GE gr rvs (L NoLoc IW) + env = GE gr rvs (L NoLoc identW) rvs = Map.mapWithKey moduleResources (moduleMap gr) moduleResources m = Map.mapWithKey (moduleResource m) . jments moduleResource m c _info = do L l t <- lookupResDefLoc gr (m,c) @@ -115,7 +114,7 @@ value env t0 = Vr x -> var env x Q x@(m,f) | m == cPredef -> if f==cErrorType -- to be removed - then let p = identC (BS.pack "P") + then let p = identS "P" in const # value0 env (mkProd [(Implicit,p,typeType)] (Vr p) []) else const . flip VApp [] # predef f | otherwise -> const # resource env x --valueResDef (fst env) x diff --git a/src/compiler/GF/Compile/Compute/ConcreteNew1.hs b/src/compiler/GF/Compile/Compute/ConcreteNew1.hs index 59c9ef6b4..354f8249e 100644 --- a/src/compiler/GF/Compile/Compute/ConcreteNew1.hs +++ b/src/compiler/GF/Compile/Compute/ConcreteNew1.hs @@ -9,7 +9,6 @@ import GF.Grammar.Predef import GF.Data.Operations import Data.List (intersect) import Text.PrettyPrint -import qualified Data.ByteString.Char8 as BS normalForm :: SourceGrammar -> Term -> Term normalForm gr t = value2term gr [] (eval gr [] t) @@ -44,7 +43,7 @@ eval gr env (Vr x) = case lookup x env of Nothing -> error ("Unknown variable "++showIdent x) eval gr env (Q x) | x == (cPredef,cErrorType) -- to be removed - = let varP = identC (BS.pack "P") + = let varP = identS "P" in eval gr [] (mkProd [(Implicit,varP,typeType)] (Vr varP) []) | fst x == cPredef = VApp x [] | otherwise = case lookupResDef gr x of diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs index 47b9c3cb5..82f8ba61a 100644 --- a/src/compiler/GF/Compile/GeneratePMCFG.hs +++ b/src/compiler/GF/Compile/GeneratePMCFG.hs @@ -32,7 +32,6 @@ import qualified Data.Set as Set import qualified Data.List as List import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet -import qualified Data.ByteString.Char8 as BS import Text.PrettyPrint hiding (Str) import Data.Array.IArray import Data.Array.Unboxed @@ -553,10 +552,8 @@ evalTerm path (EInt n) = return (EInt n) evalTerm path t = ppbug (text "evalTerm" <+> parens (ppU 0 t)) --evalTerm path t = ppbug (text "evalTerm" <+> sep [parens (text (show path)),parens (text (show t))]) -getVarIndex (IA _ i) = i -getVarIndex (IAV _ _ i) = i -getVarIndex (IC s) | isDigit (BS.last s) = (read . BS.unpack . snd . BS.spanEnd isDigit) s -getVarIndex x = bug ("getVarIndex "++show x) +getVarIndex x = maybe err id $ getArgIndex x + where err = bug ("getVarIndex "++show x) ---------------------------------------------------------------------- -- GrammarEnv diff --git a/src/compiler/GF/Compile/Optimize.hs b/src/compiler/GF/Compile/Optimize.hs index 11d30d051..9ee50251b 100644 --- a/src/compiler/GF/Compile/Optimize.hs +++ b/src/compiler/GF/Compile/Optimize.hs @@ -35,7 +35,6 @@ import Data.List import qualified Data.Set as Set import Text.PrettyPrint import Debug.Trace -import qualified Data.ByteString.Char8 as BS -- | partial evaluation of concrete syntax. AR 6\/2001 -- 16\/5\/2003 -- 5\/2\/2005. @@ -194,7 +193,7 @@ factor param c i t = else V ty (map snd pvs0) --- we hope this will be fresh and don't check... in GFC would be safe - qvar = identC (BS.pack ("q_" ++ showIdent c ++ "__" ++ show i)) + qvar = identS ("q_" ++ showIdent c ++ "__" ++ show i) mkFun (patt, val) = replace (patt2term patt) (Vr qvar) val mkCases t = [(PV qvar, t)] diff --git a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs index e2473aae8..583d614d3 100644 --- a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs +++ b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs @@ -13,7 +13,6 @@ import GF.Data.Operations import Text.PrettyPrint import Data.List (nub, (\\), tails) import qualified Data.IntMap as IntMap -import qualified Data.ByteString.Char8 as BS import GF.Grammar.Parser import System.IO @@ -438,8 +437,8 @@ quantify gr scope t tvs ty0 = do bndrs _ = [] allBinders :: [Ident] -- a,b,..z, a1, b1,... z1, a2, b2,... -allBinders = [ identC (BS.pack [x]) | x <- ['a'..'z'] ] ++ - [ identC (BS.pack (x : show i)) | i <- [1 :: Integer ..], x <- ['a'..'z']] +allBinders = [ identS [x] | x <- ['a'..'z'] ] ++ + [ identS (x : show i) | i <- [1 :: Integer ..], x <- ['a'..'z']] ----------------------------------------------------------------------- @@ -502,7 +501,7 @@ setMeta i mv = TcM (\ms msgs -> TcOk () (IntMap.insert i mv ms) msgs) newVar :: Scope -> Ident newVar scope = head [x | i <- [1..], - let x = identC (BS.pack ('v':show i)), + let x = identS ('v':show i), isFree scope x] where isFree [] x = True diff --git a/src/compiler/GF/Compile/TypeCheck/TC.hs b/src/compiler/GF/Compile/TypeCheck/TC.hs index a56a8c832..5a7fa9479 100644 --- a/src/compiler/GF/Compile/TypeCheck/TC.hs +++ b/src/compiler/GF/Compile/TypeCheck/TC.hs @@ -57,7 +57,7 @@ lookupConst :: Theory -> QIdent -> Err Val lookupConst th f = th f lookupVar :: Env -> Ident -> Err Val -lookupVar g x = maybe (Bad (render (text "unknown variable" <+> ppIdent x))) return $ lookup x ((IW,uVal):g) +lookupVar g x = maybe (Bad (render (text "unknown variable" <+> ppIdent x))) return $ lookup x ((identW,uVal):g) -- wild card IW: no error produced, ?0 instead. type TCEnv = (Int,Env,Env) -- cgit v1.2.3