summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorhallgren <hallgren@chalmers.se>2013-09-19 18:23:47 +0000
committerhallgren <hallgren@chalmers.se>2013-09-19 18:23:47 +0000
commit3d5b9bd1fd46a51651cbfbd45f03e5b878aebbac (patch)
tree24e9cae9268da60b1a0d633ab4d9f970deee3905 /src
parentc08f42ce9f1a0dc123896a8c94da24bb19756141 (diff)
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.
Diffstat (limited to 'src')
-rw-r--r--src/compiler/GF/Compile/Compute/AppPredefined.hs12
-rw-r--r--src/compiler/GF/Compile/Compute/ConcreteLazy.hs3
-rw-r--r--src/compiler/GF/Compile/Compute/ConcreteNew.hs5
-rw-r--r--src/compiler/GF/Compile/Compute/ConcreteNew1.hs3
-rw-r--r--src/compiler/GF/Compile/GeneratePMCFG.hs7
-rw-r--r--src/compiler/GF/Compile/Optimize.hs3
-rw-r--r--src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs7
-rw-r--r--src/compiler/GF/Compile/TypeCheck/TC.hs2
-rw-r--r--src/compiler/GF/Grammar/CF.hs6
-rw-r--r--src/compiler/GF/Grammar/MMacros.hs2
-rw-r--r--src/compiler/GF/Grammar/Parser.y10
-rw-r--r--src/compiler/GF/Grammar/Predef.hs246
-rw-r--r--src/compiler/GF/Infra/Ident.hs25
-rw-r--r--src/compiler/GF/Infra/Option.hs4
-rw-r--r--src/compiler/GF/Infra/UseIO.hs1
-rw-r--r--src/compiler/GF/Speech/CFG.hs1
-rw-r--r--src/compiler/GFC.hs7
-rw-r--r--src/compiler/GFI.hs2
18 files changed, 105 insertions, 241 deletions
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<j then predefTrue else predefFalse
(EInt i, EInt j) | f == cPlus -> 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)
diff --git a/src/compiler/GF/Grammar/CF.hs b/src/compiler/GF/Grammar/CF.hs
index 8b66bd72d..cb5c91bde 100644
--- a/src/compiler/GF/Grammar/CF.hs
+++ b/src/compiler/GF/Grammar/CF.hs
@@ -16,7 +16,7 @@ module GF.Grammar.CF (getCF,CFItem,CFCat,CFFun,cf2gf,CFRule) where
import GF.Grammar.Grammar
import GF.Grammar.Macros
-import GF.Infra.Ident
+import GF.Infra.Ident(Ident,identS)
import GF.Infra.Option
import GF.Infra.UseIO
@@ -25,7 +25,6 @@ import GF.Data.Utilities (nub')
import Data.Char
import Data.List
-import qualified Data.ByteString.Char8 as BS
import System.FilePath
getCF :: FilePath -> String -> Err SourceGrammar
@@ -126,6 +125,3 @@ cf2rule (L loc (fun, (cat, items))) = (def,ldef) where
mkIt (_, Right a) = K a
foldconcat [] = K ""
foldconcat tt = foldr1 C tt
-
-identS = identC . BS.pack
-
diff --git a/src/compiler/GF/Grammar/MMacros.hs b/src/compiler/GF/Grammar/MMacros.hs
index c52ee4ce2..f1d2f172a 100644
--- a/src/compiler/GF/Grammar/MMacros.hs
+++ b/src/compiler/GF/Grammar/MMacros.hs
@@ -215,7 +215,7 @@ freeVarsExp e = case e of
_ -> [] --- thus applies to abstract syntax only
int2var :: Int -> Ident
-int2var = identC . BS.pack . ('$':) . show
+int2var = identS . ('$':) . show
meta0 :: MetaId
meta0 = 0
diff --git a/src/compiler/GF/Grammar/Parser.y b/src/compiler/GF/Grammar/Parser.y
index 21b45de73..a84db6ffd 100644
--- a/src/compiler/GF/Grammar/Parser.y
+++ b/src/compiler/GF/Grammar/Parser.y
@@ -16,7 +16,6 @@ import GF.Grammar.Predef
import GF.Grammar.Grammar
import GF.Grammar.Macros
import GF.Grammar.Lexer
-import qualified Data.ByteString.Char8 as BS
import GF.Compile.Update (buildAnyTree)
import Codec.Binary.UTF8.String(decodeString)
import Data.Char(toLower)
@@ -622,12 +621,9 @@ optDecode opts =
else id
mkListId,mkConsId,mkBaseId :: Ident -> Ident
-mkListId = prefixId (BS.pack "List")
-mkConsId = prefixId (BS.pack "Cons")
-mkBaseId = prefixId (BS.pack "Base")
-
-prefixId :: BS.ByteString -> Ident -> Ident
-prefixId pref id = identC (BS.append pref (ident2bs id))
+mkListId = prefixIdent "List"
+mkConsId = prefixIdent "Cons"
+mkBaseId = prefixIdent "Base"
listCatDef :: L (Ident, Context, Int) -> [(Ident,Info)]
listCatDef (L loc (id,cont,size)) = [catd,nilfund,consfund]
diff --git a/src/compiler/GF/Grammar/Predef.hs b/src/compiler/GF/Grammar/Predef.hs
index 71b0cef3d..8bee8dcb5 100644
--- a/src/compiler/GF/Grammar/Predef.hs
+++ b/src/compiler/GF/Grammar/Predef.hs
@@ -8,195 +8,65 @@
-- Predefined identifiers and labels which the compiler knows
----------------------------------------------------------------------
-
-module GF.Grammar.Predef
- ( cType
- , cPType
- , cTok
- , cStr
- , cStrs
- , cPredefAbs, cPredefCnc, cPredef
- , cInt
- , cFloat
- , cString
- , cVar
- , cInts
- , cNonExist
- , cPBool
- , cErrorType
- , cOverload
- , cUndefinedType
- , isPredefCat
-
- , cPTrue, cPFalse
-
- , cLength, cDrop, cTake, cTk, cDp, cEqStr, cOccur
- , cOccurs, cEqInt, cLessInt, cPlus, cShow, cRead
- , cToStr, cMapStr, cError
- , cToUpper, cToLower, cIsUpper
- , cEqVal
-
- -- hacks
- , cMeta, cAs, cChar, cChars, cSeq, cAlt, cRep
- , cNeg, cCNC, cConflict
- ) where
-
-import GF.Infra.Ident
-import qualified Data.ByteString.Char8 as BS
-
-cType :: Ident
-cType = identC (BS.pack "Type")
-
-cPType :: Ident
-cPType = identC (BS.pack "PType")
-
-cTok :: Ident
-cTok = identC (BS.pack "Tok")
-
-cStr :: Ident
-cStr = identC (BS.pack "Str")
-
-cStrs :: Ident
-cStrs = identC (BS.pack "Strs")
-
-cPredefAbs :: Ident
-cPredefAbs = identC (BS.pack "PredefAbs")
-
-cPredefCnc :: Ident
-cPredefCnc = identC (BS.pack "PredefCnc")
-
-cPredef :: Ident
-cPredef = identC (BS.pack "Predef")
-
-cInt :: Ident
-cInt = identC (BS.pack "Int")
-
-cFloat :: Ident
-cFloat = identC (BS.pack "Float")
-
-cString :: Ident
-cString = identC (BS.pack "String")
-
-cVar :: Ident
-cVar = identC (BS.pack "__gfVar")
-
-cInts :: Ident
-cInts = identC (BS.pack "Ints")
-
-cPBool :: Ident
-cPBool = identC (BS.pack "PBool")
-
-cErrorType :: Ident
-cErrorType = identC (BS.pack "Error")
-
-cOverload :: Ident
-cOverload = identC (BS.pack "overload")
-
-cUndefinedType :: Ident
-cUndefinedType = identC (BS.pack "UndefinedType")
-
-cNonExist :: Ident
-cNonExist = identC (BS.pack "nonExist")
+module GF.Grammar.Predef where
+
+import GF.Infra.Ident(Ident,identS)
+
+cType = identS "Type"
+cPType = identS "PType"
+cTok = identS "Tok"
+cStr = identS "Str"
+cStrs = identS "Strs"
+cPredefAbs = identS "PredefAbs"
+cPredefCnc = identS "PredefCnc"
+cPredef = identS "Predef"
+cInt = identS "Int"
+cFloat = identS "Float"
+cString = identS "String"
+cVar = identS "__gfVar"
+cInts = identS "Ints"
+cPBool = identS "PBool"
+cErrorType = identS "Error"
+cOverload = identS "overload"
+cUndefinedType = identS "UndefinedType"
+cNonExist = identS "nonExist"
isPredefCat :: Ident -> Bool
isPredefCat c = elem c [cInt,cString,cFloat]
-cPTrue :: Ident
-cPTrue = identC (BS.pack "PTrue")
-
-cPFalse :: Ident
-cPFalse = identC (BS.pack "PFalse")
-
-cLength :: Ident
-cLength = identC (BS.pack "length")
-
-cDrop :: Ident
-cDrop = identC (BS.pack "drop")
-
-cTake :: Ident
-cTake = identC (BS.pack "take")
-
-cTk :: Ident
-cTk = identC (BS.pack "tk")
-
-cDp :: Ident
-cDp = identC (BS.pack "dp")
-
-cToUpper :: Ident
-cToUpper = identC (BS.pack "toUpper")
-
-cToLower :: Ident
-cToLower = identC (BS.pack "toLower")
-
-cIsUpper :: Ident
-cIsUpper = identC (BS.pack "isUpper")
-
-cEqStr :: Ident
-cEqStr = identC (BS.pack "eqStr")
-
-cEqVal :: Ident
-cEqVal = identC (BS.pack "eqVal")
-
-cOccur :: Ident
-cOccur = identC (BS.pack "occur")
-
-cOccurs :: Ident
-cOccurs = identC (BS.pack "occurs")
-
-cEqInt :: Ident
-cEqInt = identC (BS.pack "eqInt")
-
-cLessInt :: Ident
-cLessInt = identC (BS.pack "lessInt")
-
-cPlus :: Ident
-cPlus = identC (BS.pack "plus")
-
-cShow :: Ident
-cShow = identC (BS.pack "show")
-
-cRead :: Ident
-cRead = identC (BS.pack "read")
-
-cToStr :: Ident
-cToStr = identC (BS.pack "toStr")
-
-cMapStr :: Ident
-cMapStr = identC (BS.pack "mapStr")
-
-cError :: Ident
-cError = identC (BS.pack "error")
-
-
---- hacks: dummy identifiers used in various places
---- Not very nice!
-
-cMeta :: Ident
-cMeta = identC (BS.singleton '?')
-
-cAs :: Ident
-cAs = identC (BS.singleton '@')
-
-cChar :: Ident
-cChar = identC (BS.singleton '?')
-
-cChars :: Ident
-cChars = identC (BS.pack "[]")
-
-cSeq :: Ident
-cSeq = identC (BS.pack "+")
-
-cAlt :: Ident
-cAlt = identC (BS.pack "|")
-
-cRep :: Ident
-cRep = identC (BS.pack "*")
-
-cNeg :: Ident
-cNeg = identC (BS.pack "-")
-
-cCNC :: Ident
-cCNC = identC (BS.pack "CNC")
-
-cConflict :: Ident
-cConflict = IC (BS.pack "#conflict")
+cPTrue = identS "PTrue"
+cPFalse = identS "PFalse"
+cLength = identS "length"
+cDrop = identS "drop"
+cTake = identS "take"
+cTk = identS "tk"
+cDp = identS "dp"
+cToUpper = identS "toUpper"
+cToLower = identS "toLower"
+cIsUpper = identS "isUpper"
+cEqStr = identS "eqStr"
+cEqVal = identS "eqVal"
+cOccur = identS "occur"
+cOccurs = identS "occurs"
+cEqInt = identS "eqInt"
+cLessInt = identS "lessInt"
+cPlus = identS "plus"
+cShow = identS "show"
+cRead = identS "read"
+cToStr = identS "toStr"
+cMapStr = identS "mapStr"
+cError = identS "error"
+
+-- * Hacks: dummy identifiers used in various places.
+-- Not very nice!
+
+cMeta = identS "?"
+cAs = identS "@"
+cChar = identS "?"
+cChars = identS "[]"
+cSeq = identS "+"
+cAlt = identS "|"
+cRep = identS "*"
+cNeg = identS "-"
+cCNC = identS "CNC"
+cConflict = identS "#conflict"
diff --git a/src/compiler/GF/Infra/Ident.hs b/src/compiler/GF/Infra/Ident.hs
index 967945be9..bb26ea98c 100644
--- a/src/compiler/GF/Infra/Ident.hs
+++ b/src/compiler/GF/Infra/Ident.hs
@@ -13,9 +13,10 @@
-----------------------------------------------------------------------------
module GF.Infra.Ident (-- * Identifiers
- Ident(..), ident2bs, showIdent, ppIdent,
- identC, identV, identA, identAV, identW,
- argIdent, varStr, varX, isWildIdent, varIndex,
+ Ident, ident2bs, showIdent, ppIdent, prefixIdent,
+ identS, identC, identV, identA, identAV, identW,
+ argIdent, isArgIdent, getArgIndex,
+ varStr, varX, isWildIdent, varIndex,
-- * refreshing identifiers
IdState, initIdStateN, initIdState,
lookVar, refVar, refVarPlus
@@ -23,6 +24,7 @@ module GF.Infra.Ident (-- * Identifiers
import GF.Data.Operations
import qualified Data.ByteString.Char8 as BS
+import Data.Char(isDigit)
import Text.PrettyPrint
@@ -54,6 +56,9 @@ showIdent i = BS.unpack $! ident2bs i
ppIdent :: Ident -> Doc
ppIdent = text . showIdent
+identS :: String -> Ident
+identS = identC . BS.pack
+
identC :: BS.ByteString -> Ident
identV :: BS.ByteString -> Int -> Ident
identA :: BS.ByteString -> Int -> Ident
@@ -62,6 +67,10 @@ identW :: Ident
(identC, identV, identA, identAV, identW) =
(IC, IV, IA, IAV, IW)
+
+prefixIdent :: String -> Ident -> Ident
+prefixIdent pref = identC . BS.append (BS.pack pref) . ident2bs
+
-- normal identifier
-- ident s = IC s
@@ -70,6 +79,16 @@ argIdent :: Int -> Ident -> Int -> Ident
argIdent 0 (IC c) i = identA c i
argIdent b (IC c) i = identAV c b i
+isArgIdent IA{} = True
+isArgIdent IAV{} = True
+isArgIdent _ = False
+
+getArgIndex (IA _ i) = Just i
+getArgIndex (IAV _ _ i) = Just i
+getArgIndex (IC s)
+ | isDigit (BS.last s) = (Just . read . BS.unpack . snd . BS.spanEnd isDigit) s
+getArgIndex x = Nothing
+
-- | used in lin defaults
varStr :: Ident
varStr = identA (BS.pack "str") 0
diff --git a/src/compiler/GF/Infra/Option.hs b/src/compiler/GF/Infra/Option.hs
index c4aecae23..554468783 100644
--- a/src/compiler/GF/Infra/Option.hs
+++ b/src/compiler/GF/Infra/Option.hs
@@ -42,8 +42,6 @@ import GF.Data.ErrM
import Data.Set (Set)
import qualified Data.Set as Set
-import qualified Data.ByteString.Char8 as BS
-
usageHeader :: String
@@ -398,7 +396,7 @@ optDescr =
Just p -> set $ \o -> o { optHaskellOptions = Set.insert p (optHaskellOptions o) }
Nothing -> fail $ "Unknown Haskell option: " ++ x
++ " Known: " ++ show (map fst haskellOptionNames)
- literalCat x = set $ \o -> o { optLiteralCats = foldr Set.insert (optLiteralCats o) ((map (identC . BS.pack) . splitBy (==',')) x) }
+ literalCat x = set $ \o -> o { optLiteralCats = foldr Set.insert (optLiteralCats o) ((map identS . splitBy (==',')) x) }
lexicalCat x = set $ \o -> o { optLexicalCats = foldr Set.insert (optLexicalCats o) (splitBy (==',') x) }
outDir x = set $ \o -> o { optOutputDir = Just x }
gfLibPath x = set $ \o -> o { optGFLibPath = Just x }
diff --git a/src/compiler/GF/Infra/UseIO.hs b/src/compiler/GF/Infra/UseIO.hs
index 2fdc42d83..140c2623f 100644
--- a/src/compiler/GF/Infra/UseIO.hs
+++ b/src/compiler/GF/Infra/UseIO.hs
@@ -34,7 +34,6 @@ import Text.Printf
import Control.Monad
import Control.Monad.Trans(MonadIO(..))
import Control.Exception(evaluate)
-import qualified Data.ByteString.Char8 as BS
putShow' :: Show a => (c -> a) -> c -> IO ()
putShow' f = putStrLn . show . length . show . f
diff --git a/src/compiler/GF/Speech/CFG.hs b/src/compiler/GF/Speech/CFG.hs
index d97228322..56d360dac 100644
--- a/src/compiler/GF/Speech/CFG.hs
+++ b/src/compiler/GF/Speech/CFG.hs
@@ -13,7 +13,6 @@ import GF.Data.Relation
import Control.Monad
import Control.Monad.State (State, get, put, evalState)
-import qualified Data.ByteString.Char8 as BS
import Data.Map (Map)
import qualified Data.Map as Map
import Data.List
diff --git a/src/compiler/GFC.hs b/src/compiler/GFC.hs
index 6dc891679..c035d0676 100644
--- a/src/compiler/GFC.hs
+++ b/src/compiler/GFC.hs
@@ -10,7 +10,7 @@ import GF.Compile
import GF.Compile.Export
import GF.Grammar.CF ---- should this be on a deeper level? AR 15/10/2008
-import GF.Grammar (identC)
+import GF.Infra.Ident(identS)
import GF.Infra.UseIO
import GF.Infra.Option
@@ -21,7 +21,6 @@ import Data.Binary
import qualified Data.Map as Map
import qualified Data.ByteString as BSS
import qualified Data.ByteString.Lazy as BSL
-import qualified Data.ByteString.Char8 as BS
import System.FilePath
import System.IO
import Control.Exception
@@ -49,7 +48,7 @@ compileSourceFiles opts fs =
let cnc = justModuleName (last fs)
if flag optStopAfterPhase opts == Compile
then return ()
- else do pgf <- link opts (identC (BS.pack cnc)) gr
+ else do pgf <- link opts (identS cnc) gr
writePGF opts pgf
writeByteCode opts pgf
writeOutputs opts pgf
@@ -62,7 +61,7 @@ compileCFFiles opts fs =
gr <- compileSourceGrammar opts gf
if flag optStopAfterPhase opts == Compile
then return ()
- else do pgf <- link opts (identC (BS.pack cnc)) gr
+ else do pgf <- link opts (identS cnc) gr
writePGF opts pgf
writeOutputs opts pgf
diff --git a/src/compiler/GFI.hs b/src/compiler/GFI.hs
index 5412053e8..bd67f29bc 100644
--- a/src/compiler/GFI.hs
+++ b/src/compiler/GFI.hs
@@ -333,7 +333,7 @@ checkComputeTerm' new sgr t = do
((t,_),_) <- runCheck $ do t <- renameSourceTerm sgr mo t
inferLType sgr [] t
t1 <- if new
- then return (CN.normalForm (CN.resourceValues sgr) (L NoLoc IW) t)
+ then return (CN.normalForm (CN.resourceValues sgr) (L NoLoc identW) t)
else computeConcrete sgr t
checkPredefError sgr t1